/**********************************************************************
 * plperl.c - perl作为PostgreSQL的过程语言
 *
 *	  src/pl/plperl/plperl.c
 *
 **********************************************************************/

#include "postgres.h"

/* 系统相关内容 */
#include <ctype.h>
#include <fcntl.h>
#include <limits.h>
#include <unistd.h>

/* postgreSQL相关内容 */
#include "access/htup_details.h"
#include "access/xact.h"
#include "catalog/pg_language.h"
#include "catalog/pg_proc.h"
#include "catalog/pg_type.h"
#include "commands/event_trigger.h"
#include "commands/trigger.h"
#include "executor/spi.h"
#include "funcapi.h"
#include "mb/pg_wchar.h"
#include "miscadmin.h"
#include "nodes/makefuncs.h"
#include "parser/parse_type.h"
#include "storage/ipc.h"
#include "tcop/tcopprot.h"
#include "utils/builtins.h"
#include "utils/fmgroids.h"
#include "utils/guc.h"
#include "utils/hsearch.h"
#include "utils/lsyscache.h"
#include "utils/memutils.h"
#include "utils/rel.h"
#include "utils/syscache.h"
#include "utils/typcache.h"

/* 为翻译定义我们的文本域 */
#undef TEXTDOMAIN
#define TEXTDOMAIN PG_TEXTDOMAIN("plperl")

/* perl相关内容 */
/* 定义perl代码块的字符串字面量宏 */
#include "perlchunks.h"
#include "plperl.h"
#include "plperl_helpers.h"
/* 定义PLPERL_SET_OPMASK */
#include "plperl_opmask.h"

EXTERN_C void boot_DynaLoader(pTHX_ CV *fc_cv);
EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *fc_cv);
EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *fc_cv);

PG_MODULE_MAGIC;

/**********************************************************************
 * 与Perl解释器相关的信息。我们有一个用于所有plperlu（不受信任）函数的解释器。
 * 对于plperl（受信任）函数，每个有效的SQL用户标识符都有一个单独的解释器。
 * （这需要确保一个没有特权的用户不能注入将以其他SQL用户的权限执行的Perl代码。）
 *
 * plperl_interp_desc结构保存在一个Postgres哈希表中，通过用户标识符OID索引，
 * OID 0用于单个不受信任的解释器。一旦创建，解释器将在进程的生命周期内保持。
 *
 * 我们一开始创建一个“持有的”解释器，我们仅根据能否决定它是否受信任或不受信任来初始化。
 * 后来，当我们第一次需要运行plperl或plperlu函数时，我们适当地完成初始化，并将
 * PerlInterpreter指针移动到plperl_interp_hash哈希表中。如果之后我们需要更多解释器，
 * 我们在可能的情况下按需创建它们，或者如果Perl构建不支持多个解释器则失败。
 *
 * 所有关于持有解释器的操作是为了使用户能够在postmaster启动时预加载大量的Perl代码
 * （使用plperl.on_init），然后在后端使用该代码。当然，这仅对在任何后端创建的第一个
 * 解释器有效，但在这种限制下仍然有用。
 **********************************************************************/
typedef struct plperl_interp_desc
{
	Oid			user_id;		/* 哈希键（必须是第一个！） */
	PerlInterpreter *interp;	/* 解释器 */
	HTAB	   *query_hash;		/* plperl_query_entry结构 */
} plperl_interp_desc;


/**********************************************************************
 * 我们缓存的有关加载的过程的信息
 *
 * fn_refcount字段计算来自下面的哈希表的结构引用加上每个使用
 * 该结构的函数调用层级的一个引用。当fn_refcount归零时，
 * 我们可以释放该结构及其关联的Perl子程序。释放结构本身是通过
 * 删除fn_cxt来实现的，这也会去掉所有附属数据。
 **********************************************************************/
typedef struct plperl_proc_desc
{
	char	   *proname;		/* 程序的用户名 */
	MemoryContext fn_cxt;		/* 该程序的内存上下文 */
	unsigned long fn_refcount;	/* 活跃引用的数量 */
	TransactionId fn_xmin;		/* 程序的pg_proc元组的xmin/TID */
	ItemPointerData fn_tid;
	SV		   *reference;		/* Perl子程序的CODE引用 */
	plperl_interp_desc *interp; /* 其创建的解释器 */
	bool		fn_readonly;	/* 函数是只读的（非易失性）？ */
	Oid			lang_oid;
	List	   *trftypes;
	bool		lanpltrusted;	/* 是 plperl，而不是 plperlu？ */
	bool		fn_retistuple;	/* 如果函数返回元组，则为真 */
	bool		fn_retisset;	/* 如果函数返回集合，则为真 */
	bool		fn_retisarray;	/* 如果函数返回数组，则为真 */
	/* 函数结果类型的转换信息： */
	Oid			result_oid;		/* 结果类型的 Oid */
	FmgrInfo	result_in_func; /* 结果类型的 I/O 函数和参数 */
	Oid			result_typioparam;
	/* 每个参数信息函数的参数类型： */
	int			nargs;
	FmgrInfo   *arg_out_func;	/* 参数类型的输出函数 */
	bool	   *arg_is_rowtype; /* 每个参数都是复合类型吗？ */
	Oid		   *arg_arraytype;	/* 如果不是数组则为 InvalidOid */
} plperl_proc_desc;

#define increment_prodesc_refcount(prodesc)  \
	((prodesc)->fn_refcount++)
#define decrement_prodesc_refcount(prodesc)  \
	do { \
		Assert((prodesc)->fn_refcount > 0); \
		if (--((prodesc)->fn_refcount) == 0) \
			fc_free_plperl_function(prodesc); \
	} while(0)

/**********************************************************************
 * 为快速查找，我们维护一个哈希表，将
 * 函数 OID + 触发器标志 + 用户 OID 映射到 plperl_proc_desc 指针。
 * plperl_proc_desc 结构没有直接成为哈希条目的原因是为了简化
 * 在 compile_plperl_function 期间从错误中恢复。
 *
 * 注意：如果在一个会话中同一函数被多个 userID 调用，
 * 在 plperl 函数情况下，每个 userID 将有一个单独的 plperl_proc_desc 条目，
 * 但对于 plperlu 函数只有一个条目，因为我们
 * 在此情况下将 user_id 设置为 0。如果用户从 plperl 重声明同一函数
 * 为 plperlu，或反之，则哈希表中可能存在多个
 * plperl_proc_ptr 条目，但只有一个是有效的。
 **********************************************************************/
typedef struct plperl_proc_key
{
	Oid			proc_id;		/* 函数 OID */

	/*
	 * is_trigger 实际上是一个布尔值，但声明为 Oid 以确保该结构
	 * 不包含填充
	 */
	Oid			is_trigger;		/* 它是一个触发器函数吗？ */
	Oid			user_id;		/* 调用函数的用户，或 0 */
} plperl_proc_key;

typedef struct plperl_proc_ptr
{
	plperl_proc_key proc_key;	/* 哈希键（必须是第一个！） */
	plperl_proc_desc *proc_ptr;
} plperl_proc_ptr;

/*
 * 我们在函数单次调用期间缓存的信息。
 */
typedef struct plperl_call_data
{
	plperl_proc_desc *prodesc;
	FunctionCallInfo fcinfo;
	/* 剩余字段仅在返回集合的函数中使用： */
	Tuplestorestate *tuple_store;
	TupleDesc	ret_tdesc;
	Oid			cdomain_oid;	/* 0，除非返回域复合类型 */
	void	   *cdomain_info;
	MemoryContext tmp_cxt;
} plperl_call_data;

/**********************************************************************
 * 我们关于准备和保存计划的缓存信息
 **********************************************************************/
typedef struct plperl_query_desc
{
	char		qname[24];
	MemoryContext plan_cxt;		/* 持有该结构的上下文 */
	SPIPlanPtr	plan;
	int			nargs;
	Oid		   *argtypes;
	FmgrInfo   *arginfuncs;
	Oid		   *argtypioparams;
} plperl_query_desc;

/* 查询描述的哈希表条目 */

typedef struct plperl_query_entry
{
	char		query_name[NAMEDATALEN];
	plperl_query_desc *query_data;
} plperl_query_entry;

/**********************************************************************
 * PostgreSQL - Perl 数组转换的信息。
 **********************************************************************/
typedef struct plperl_array_info
{
	int			ndims;
	bool		elem_is_rowtype;	/* 如果元素类型是行类型，则为 't' */
	Datum	   *elements;
	bool	   *nulls;
	int		   *nelems;
	FmgrInfo	proc;
	FmgrInfo	transform_proc;
} plperl_array_info;

/**********************************************************************
 * 全局数据
 **********************************************************************/

static HTAB *plperl_interp_hash = NULL;
static HTAB *plperl_proc_hash = NULL;
static plperl_interp_desc *plperl_active_interp = NULL;

/* 如果我们有一个未分配的“保持”解释器，它存储在这里 */
static PerlInterpreter *plperl_held_interp = NULL;

/* GUC 变量 */
static bool plperl_use_strict = false;
static char *plperl_on_init = NULL;
static char *plperl_on_plperl_init = NULL;
static char *plperl_on_plperlu_init = NULL;

static bool plperl_ending = false;
static OP  *(*pp_require_orig) (pTHX) = NULL;
static char plperl_opmask[MAXO];

/* 这是由 plperl_call_handler 保存和恢复的 */
static plperl_call_data *current_call_data = NULL;

/**********************************************************************
 * 前向声明
 **********************************************************************/
void		_PG_init(void);

static PerlInterpreter *fc_plperl_init_interp(void);
static void fc_plperl_destroy_interp(PerlInterpreter **);
static void fc_plperl_fini(int fc_code, Datum fc_arg);
static void fc_set_interp_require(bool fc_trusted);

static Datum fc_plperl_func_handler(PG_FUNCTION_ARGS);
static Datum fc_plperl_trigger_handler(PG_FUNCTION_ARGS);
static void fc_plperl_event_trigger_handler(PG_FUNCTION_ARGS);

static void fc_free_plperl_function(plperl_proc_desc *fc_prodesc);

static plperl_proc_desc *fc_compile_plperl_function(Oid fc_fn_oid,
												 bool fc_is_trigger,
												 bool fc_is_event_trigger);

static SV  *fc_plperl_hash_from_tuple(HeapTuple fc_tuple, TupleDesc fc_tupdesc, bool fc_include_generated);
static SV  *fc_plperl_hash_from_datum(Datum fc_attr);
static void fc_check_spi_usage_allowed(void);
static SV  *fc_plperl_ref_from_pg_array(Datum fc_arg, Oid fc_typid);
static SV  *fc_split_array(plperl_array_info *fc_info, int fc_first, int fc_last, int fc_nest);
static SV  *fc_make_array_ref(plperl_array_info *fc_info, int fc_first, int fc_last);
static SV  *fc_get_perl_array_ref(SV *fc_sv);
static Datum fc_plperl_sv_to_datum(SV *fc_sv, Oid fc_typid, int32 fc_typmod,
								FunctionCallInfo fc_fcinfo,
								FmgrInfo *fc_finfo, Oid fc_typioparam,
								bool *fc_isnull);
static void fc__sv_to_datum_finfo(Oid fc_typid, FmgrInfo *fc_finfo, Oid *fc_typioparam);
static Datum fc_plperl_array_to_datum(SV *fc_src, Oid fc_typid, int32 fc_typmod);
static void fc_array_to_datum_internal(AV *fc_av, ArrayBuildState **fc_astatep,
									int *fc_ndims, int *fc_dims, int fc_cur_depth,
									Oid fc_elemtypid, int32 fc_typmod,
									FmgrInfo *fc_finfo, Oid fc_typioparam);
static Datum fc_plperl_hash_to_datum(SV *fc_src, TupleDesc fc_td);

static void fc_plperl_init_shared_libs(pTHX);
static void fc_plperl_trusted_init(void);
static void fc_plperl_untrusted_init(void);
static HV  *fc_plperl_spi_execute_fetch_result(SPITupleTable *, uint64, int);
static void fc_plperl_return_next_internal(SV *fc_sv);
static char *fc_hek2cstr(HE *fc_he);
static SV **fc_hv_store_string(HV *fc_hv, const char *fc_key, SV *fc_val);
static SV **fc_hv_fetch_string(HV *fc_hv, const char *fc_key);
static void fc_plperl_create_sub(plperl_proc_desc *fc_desc, const char *fc_s, Oid fc_fn_oid);
static SV  *fc_plperl_call_perl_func(plperl_proc_desc *fc_desc,
								  FunctionCallInfo fc_fcinfo);
static void fc_plperl_compile_callback(void *fc_arg);
static void fc_plperl_exec_callback(void *fc_arg);
static void fc_plperl_inline_callback(void *fc_arg);
static char *fc_strip_trailing_ws(const char *fc_msg);
static OP  *fc_pp_require_safe(pTHX);
static void fc_activate_interpreter(plperl_interp_desc *fc_interp_desc);

#if defined(WIN32) && PERL_VERSION_LT(5, 28, 0)
static char *setlocale_perl(int category, char *locale);
#else
#define setlocale_perl(a,b)  Perl_setlocale(a,b)
#endif							/* 定义(WIN32) && PERL_VERSION_LT(5, 28, 0) */

/*
 * 在活动的 Perl 解释器中递减给定 SV 的引用计数
 *
 * 这很方便，因为它会重新加载活动解释器指针，节省
 * 在切换活动解释器的调用者中的一些标注。
 */
static inline void fc_SvREFCNT_dec_current(SV *fc_sv)
{
	dTHX;

	SvREFCNT_dec(fc_sv);
}

/*
 * 将 HE（哈希条目）键转换为当前数据库编码中的 cstr
 */
static char * fc_hek2cstr(HE *fc_he)
{
	dTHX;
	char	   *fc_ret;
	SV		   *fc_sv;

	/*
	 * HeSVKEY_force 将返回一个临时的 mortal SV*，所以我们需要确保
	 * 用 ENTER/SAVE/FREE/LEAVE 来释放它
	 */
	ENTER;
	SAVETMPS;

	/*-------------------------
	 * 不幸的是，虽然 HeUTF8 对于大多数大于 256 的事物为真，对于值
	 * 128..255 却不是，但是如果未设置 utf8 标志，perl 将将它们视为
	 * unicode 代码点（见 perldoc perlunicode 中的 "Unicode Bug"
	 * 以了解更多信息）。
	 *
	 * 所以如果我们做了预期：
	 *	  if (HeUTF8(he))
	 *		  utf_u2e(key...);
	 *	  else // 必须是 ascii
	 *		  return HePV(he);
	 * 我们将无法匹配代码点在 128..255 范围内的列。
	 *
	 * 更具体的一个例子是给定一个名称为 unicode 代码点 U+00ae（注册符号）的列
	 * 和一个 UTF8 数据库，perl 返回的 next { "\N{U+00ae}=>'text } 将始终失败，
	 * 因为 heUTF8 返回 0，而 HePV() 将给我们一个 char *，其中 1 个字节包含
	 * 十进制值 174。
	 *
	 * Perl 有智慧知道何时应该正确地 utf8 编码 174，所以
	 * 在这里我们将其强制转换为 SV，以便 perl 能够找出并做正确的事情。
	 *-------------------------
	 */

	fc_sv = HeSVKEY_force(fc_he);
	if (HeUTF8(fc_he))
		SvUTF8_on(fc_sv);
	fc_ret = sv2cstr(fc_sv);

	/* 释放 sv */
	FREETMPS;
	LEAVE;

	return fc_ret;
}


/*
 * _PG_init()			- 库加载时初始化
 *
 * 请勿将此设置为静态或更改其名称！
 */
void _PG_init(void)
{
	/*
	 * 确保我们只进行一次初始化。
	 *
	 * 如果初始化由于例如 plperl_init_interp() 抛出异常而失败，
	 * 那么在下次使用时我们将返回到这里，用户将得到一个相当神秘的：
	 * ERROR:  尝试重新定义参数 "plperl.use_strict"
	 */
	static bool fc_inited = false;
	HASHCTL		fc_hash_ctl;

	if (fc_inited)
		return;

	/*
	 * 支持本地化消息。
	 */
	pg_bindtextdomain(TEXTDOMAIN);

	/*
	 * 初始化 plperl 的 GUCs。
	 */
	DefineCustomBoolVariable("plperl.use_strict",
							 gettext_noop("If true, trusted and untrusted Perl code will be compiled in strict mode."),
							 NULL,
							 &plperl_use_strict,
							 false,
							 PGC_USERSET, 0,
							 NULL, NULL, NULL);

	/*
	 * plperl.on_init 标记为 PGC_SIGHUP，以支持可能在 postmaster 中执行
	 * 的想法（如果通过 shared_preload_libraries 将 plperl 加载到
	 * postmaster 中）。  不过，这两种情况都不是很正确。
	 */
	DefineCustomStringVariable("plperl.on_init",
							   gettext_noop("Perl initialization code to execute when a Perl interpreter is initialized."),
							   NULL,
							   &plperl_on_init,
							   NULL,
							   PGC_SIGHUP, 0,
							   NULL, NULL, NULL);

	/*
	 * plperl.on_plperl_init 标记为 PGC_SUSET，以避免问题，即
	 * 可能根本没有 plperl 语言的 USAGE 权限的用户
	 * 仍然可以使用 SET plperl.on_plperl_init='...' 来影响
	 * 他们可以执行的任何现有 plperl 函数的行为（这可能是 SECURITY DEFINER，
	 * 导致特权升级）。  请参见
	 * http://archives.postgresql.org/pgsql-hackers/2010-02/msg00281.php 及
	 * 整个主题。
	 *
	 * 请注意，由于 plperl.use_strict 是 USERSET，恶意用户可以
	 * 设置其应用于其他人的函数。  这被认为是可以接受的，因为最糟糕的结果将是一个错误。
	 * 你的代码应该无论如何都能通过 use_strict ;-)
	 */
	DefineCustomStringVariable("plperl.on_plperl_init",
							   gettext_noop("Perl initialization code to execute once when plperl is first used."),
							   NULL,
							   &plperl_on_plperl_init,
							   NULL,
							   PGC_SUSET, 0,
							   NULL, NULL, NULL);

	DefineCustomStringVariable("plperl.on_plperlu_init",
							   gettext_noop("Perl initialization code to execute once when plperlu is first used."),
							   NULL,
							   &plperl_on_plperlu_init,
							   NULL,
							   PGC_SUSET, 0,
							   NULL, NULL, NULL);

	MarkGUCPrefixReserved("plperl");

	/*
	 * 创建哈希表。
	 */
	fc_hash_ctl.keysize = sizeof(Oid);
	fc_hash_ctl.entrysize = sizeof(plperl_interp_desc);
	plperl_interp_hash = hash_create("PL/Perl interpreters",
									 8,
									 &fc_hash_ctl,
									 HASH_ELEM | HASH_BLOBS);

	fc_hash_ctl.keysize = sizeof(plperl_proc_key);
	fc_hash_ctl.entrysize = sizeof(plperl_proc_ptr);
	plperl_proc_hash = hash_create("PL/Perl procedures",
								   32,
								   &fc_hash_ctl,
								   HASH_ELEM | HASH_BLOBS);

	/*
	 * 保存默认的 opmask。
	 */
	PLPERL_SET_OPMASK(plperl_opmask);

	/*
	 * 创建第一个 Perl 解释器，但仅部分初始化。
	 */
	plperl_held_interp = fc_plperl_init_interp();

	fc_inited = true;
}


static void fc_set_interp_require(bool fc_trusted)
{
	if (fc_trusted)
	{
		PL_ppaddr[OP_REQUIRE] = fc_pp_require_safe;
		PL_ppaddr[OP_DOFILE] = fc_pp_require_safe;
	}
	else
	{
		PL_ppaddr[OP_REQUIRE] = pp_require_orig;
		PL_ppaddr[OP_DOFILE] = pp_require_orig;
	}
}

/*
 * 清理 Perl 解释器，包括运行 END 块。
 * 不会完全撤销 _PG_init() 的操作，也不会使其再次可调用。
 */
static void fc_plperl_fini(int fc_code, Datum fc_arg)
{
	HASH_SEQ_STATUS fc_hash_seq;
	plperl_interp_desc *fc_interp_desc;

	elog(DEBUG3, "plperl_fini");

	/*
	 * 表示 Perl 正在终止。在运行 END/DESTROY 代码时禁用使用 spi_* 函数。
	 * 请参见 check_spi_usage_allowed()。未来可能会小心启用，
	 * 使用事务 http://archives.postgresql.org/pgsql-hackers/2010-01/msg02743.php
	 */
	plperl_ending = true;

	/* 仅在干净退出时执行 Perl 清理 */
	if (fc_code)
	{
		elog(DEBUG3, "plperl_fini: skipped");
		return;
	}

	/* 如果我们还有“保持”的解释器，则销毁它 */
	fc_plperl_destroy_interp(&plperl_held_interp);

	/* 销毁任何完全初始化的解释器 */
	hash_seq_init(&fc_hash_seq, plperl_interp_hash);
	while ((fc_interp_desc = hash_seq_search(&fc_hash_seq)) != NULL)
	{
		if (fc_interp_desc->interp)
		{
			fc_activate_interpreter(fc_interp_desc);
			fc_plperl_destroy_interp(&fc_interp_desc->interp);
		}
	}

	elog(DEBUG3, "plperl_fini: done");
}


/*
 * 选择并激活一个合适的 Perl 解释器。
 */
static void fc_select_perl_context(bool fc_trusted)
{
	Oid			fc_user_id;
	plperl_interp_desc *fc_interp_desc;
	bool		fc_found;
	PerlInterpreter *fc_interp = NULL;

	/* 查找或创建此用户 ID 的解释器哈希表条目 */
	if (fc_trusted)
		fc_user_id = GetUserId();
	else
		fc_user_id = InvalidOid;

	fc_interp_desc = hash_search(plperl_interp_hash, &fc_user_id,
							  HASH_ENTER,
							  &fc_found);
	if (!fc_found)
	{
		/* 初始化新创建的哈希表条目 */
		fc_interp_desc->interp = NULL;
		fc_interp_desc->query_hash = NULL;
	}

	/* 确保我们有此解释器的 query_hash */
	if (fc_interp_desc->query_hash == NULL)
	{
		HASHCTL		fc_hash_ctl;

		fc_hash_ctl.keysize = NAMEDATALEN;
		fc_hash_ctl.entrysize = sizeof(plperl_query_entry);
		fc_interp_desc->query_hash = hash_create("PL/Perl queries",
											  32,
											  &fc_hash_ctl,
											  HASH_ELEM | HASH_STRINGS);
	}

	/*
	 * 如果已经有解释器则快速退出
	 */
	if (fc_interp_desc->interp)
	{
		fc_activate_interpreter(fc_interp_desc);
		return;
	}

	/*
	 * 如果是空闲状态则采用保持的解释器，否则尽可能创建新的。
	 */
	if (plperl_held_interp != NULL)
	{
		/* Perl 解释器的首次实际使用 */
		fc_interp = plperl_held_interp;

		/*
		 * 首先重置 plperl_held_interp 指针；如果初始化过程中失败，
		 * 我们不想再次尝试部分初始化的解释器。
		 */
		plperl_held_interp = NULL;

		if (fc_trusted)
			fc_plperl_trusted_init();
		else
			fc_plperl_untrusted_init();

		/* 初始化成功，因此安排清理 */
		on_proc_exit(fc_plperl_fini, 0);
	}
	else
	{
#ifdef MULTIPLICITY

		/*
		 * plperl_init_interp 将改变 Perl 对活动解释器的概念。
		 * 临时重置 plperl_active_interp，以便如果我们在这里的某个过程中
		 * 遇到错误，确保在运行任何其他 Perl 函数之前切换回未损坏的解释器。
		 */
		plperl_active_interp = NULL;

		/* 现在构建新的解释器 */
		fc_interp = fc_plperl_init_interp();

		if (fc_trusted)
			fc_plperl_trusted_init();
		else
			fc_plperl_untrusted_init();
#else
		ereport(ERROR,
				(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
				 errmsg("cannot allocate multiple Perl interpreters on this platform")));
#endif
	}

	fc_set_interp_require(fc_trusted);

	/*
	 * 由于可以预测 PL/Perl 第一次使用的时机，因此初始化期间的任何
	 * 数据库交互都是有问题的。包括但不限于安全定义者问题。因此，
	 * 我们仅在 on_*_init 代码运行之后才启用数据库访问。请参见
	 * http://archives.postgresql.org/pgsql-hackers/2010-01/msg02669.php
	 */
	{
		dTHX;

		newXS("PostgreSQL::InServer::SPI::bootstrap",
			  boot_PostgreSQL__InServer__SPI, __FILE__);

		eval_pv("PostgreSQL::InServer::SPI::bootstrap()", FALSE);
		if (SvTRUE(ERRSV))
			ereport(ERROR,
					(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
					 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
					 errcontext("while executing PostgreSQL::InServer::SPI::bootstrap")));
	}

	/* 完全初始化，因此将哈希表条目标记为有效 */
	fc_interp_desc->interp = fc_interp;

	/* 并将其标记为活动解释器 */
	plperl_active_interp = fc_interp_desc;
}

/*
 * 使指定的解释器成为活动解释器
 *
 * NULL 调用无效。这是为了确保“恢复”到之前
 * plperl_active_interp 的空状态不会导致无用的反复操作。
 */
static void fc_activate_interpreter(plperl_interp_desc *fc_interp_desc)
{
	if (fc_interp_desc && plperl_active_interp != fc_interp_desc)
	{
		Assert(fc_interp_desc->interp);
		PERL_SET_CONTEXT(fc_interp_desc->interp);
		/* 只有当 user_id 不是 InvalidOid 时才受信任 */
		fc_set_interp_require(OidIsValid(fc_interp_desc->user_id));
		plperl_active_interp = fc_interp_desc;
	}
}

/*
 * 创建一个新的 Perl 解释器。
 *
 * 我们在不知道它会成为受信任的还是不受信任的解释器的情况下
 * 尽可能地初始化该解释器；特别是，plperl.on_init 代码将被执行。
 * 之后，必须调用 plperl_trusted_init 或 plperl_untrusted_init 来完成初始化。
 */
static PerlInterpreter *
fc_plperl_init_interp(void)
{
	PerlInterpreter *fc_plperl;

	static char *fc_embedding[3 + 2] = {
		"", "-e", PLC_PERLBOOT
	};
	int			fc_nargs = 3;

#ifdef WIN32

	/*
	 * Perl库在启动时做了一些可怕的事情，比如调用
	 * setlocale(LC_ALL,"")。我们通过适当地设置环境
	 * 在大多数平台上对此进行了保护。然而，在Windows上，
	 * setlocale()不会查询环境，因此我们需要在perl有机会
	 * 捣乱之前保存现有的区域设置，并在它的肮脏行为结束后
	 * 恢复它们。
	 *
	 * MSDN参考：
	 * http://msdn.microsoft.com/library/en-us/vclib/html/_crt_locale.asp
	 *
	 * 似乎我们只需要在解释器启动时执行此操作，后续调用
	 * 解释器不会对区域设置造成影响。
	 *
	 * 我们使用下面定义的setlocale_perl()来恢复区域设置，
	 * 以便Perl与Postgres对区域设置有一致的理解。
	 *
	 */

	char	   *loc;
	char	   *save_collate,
			   *save_ctype,
			   *save_monetary,
			   *save_numeric,
			   *save_time;

	loc = setlocale(LC_COLLATE, NULL);
	save_collate = loc ? pstrdup(loc) : NULL;
	loc = setlocale(LC_CTYPE, NULL);
	save_ctype = loc ? pstrdup(loc) : NULL;
	loc = setlocale(LC_MONETARY, NULL);
	save_monetary = loc ? pstrdup(loc) : NULL;
	loc = setlocale(LC_NUMERIC, NULL);
	save_numeric = loc ? pstrdup(loc) : NULL;
	loc = setlocale(LC_TIME, NULL);
	save_time = loc ? pstrdup(loc) : NULL;

#define PLPERL_RESTORE_LOCALE(name, saved) \
	STMT_START { \
		if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
	} STMT_END
#endif							/* WIN32 */

	if (plperl_on_init && *plperl_on_init)
	{
		fc_embedding[fc_nargs++] = "-e";
		fc_embedding[fc_nargs++] = plperl_on_init;
	}

	/*
	 * Perl API文档指出，在分配解释器之前应调用
	 * PERL_SYS_INIT3。不幸的是，在某些平台上，这在
	 * Perl_do_taint()例程中失败，该例程在平台使用
	 * 系统的malloc()而不是Perl自己的malloc()时被调用。
	 * 其他平台，特别是Windows，如果没有调用PERL_SYS_INIT3
	 * 会失败。因此，除非perl使用系统malloc()，即MYMALLOC
	 * 被设置为true时，我们会调用它。
	 */
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
	{
		static int	fc_perl_sys_init_done;

		/* 仅在第一次调用时执行，如perlembed手册页所示 */
		if (!fc_perl_sys_init_done)
		{
			char	   *fc_dummy_env[1] = {NULL};

			PERL_SYS_INIT3(&fc_nargs, (char ***) &fc_embedding, (char ***) &fc_dummy_env);

			/*
			 * 出于不明原因，PERL_SYS_INIT3将SIGFPE处理程序设置为
			 * SIG_IGN。除了对库极其不友好的行为外，从逻辑上讲，
			 * 这一做法也是愚蠢的，因为在这种状态下SIGFPE的结果
			 * 是未定义的，根据POSIX来看，实际上你会在Linux上
			 * 受到强制杀死进程的影响。因此，恢复SIGFPE处理程序
			 * 到后端的标准设置。
			 * （有关更多信息，请参见Perl错误114574。）
			 */
			pqsignal(SIGFPE, FloatExceptionHandler);

			fc_perl_sys_init_done = 1;
			/* 如果PERL_SYS_INIT3未使用第三个参数则静默警告 */
			fc_dummy_env[0] = NULL;
		}
	}
#endif

	fc_plperl = perl_alloc();
	if (!fc_plperl)
		elog(ERROR, "could not allocate Perl interpreter");

	PERL_SET_CONTEXT(fc_plperl);
	perl_construct(fc_plperl);

	/*
	 * 在perl_destruct中运行END块，而不是在perl_run中。
	 * 注意，dTHX加载了指向当前解释器的指针，因此我们必须
	 * 将其推迟到这里，而不是放在函数头部。
	 */
	{
		dTHX;

		PL_exit_flags |= PERL_EXIT_DESTRUCT_END;

		/*
		 * 记录'require'和'dofile'操作码的原始函数。
		 * （它们共享相同的实现。）确保它在新解释器中使用。
		 */
		if (!pp_require_orig)
			pp_require_orig = PL_ppaddr[OP_REQUIRE];
		else
		{
			PL_ppaddr[OP_REQUIRE] = pp_require_orig;
			PL_ppaddr[OP_DOFILE] = pp_require_orig;
		}

#ifdef PLPERL_ENABLE_OPMASK_EARLY

		/*
		 * 用于回归测试，以证明PLC_PERLBOOT和
		 * PLC_TRUSTED代码甚至无法编译任何不安全的操作。
		 * 将来可能需要它们这样做，在这种情况下，该限制可以
		 * 放宽（也许移至plperl_trusted_init()）或移除。
		 */
		PL_op_mask = plperl_opmask;
#endif

		if (perl_parse(fc_plperl, fc_plperl_init_shared_libs,
					   fc_nargs, fc_embedding, NULL) != 0)
			ereport(ERROR,
					(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
					 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
					 errcontext("while parsing Perl initialization")));

		if (perl_run(fc_plperl) != 0)
			ereport(ERROR,
					(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
					 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
					 errcontext("while running Perl initialization")));

#ifdef PLPERL_RESTORE_LOCALE
		PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
		PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
		PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary);
		PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
		PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
#endif
	}

	return fc_plperl;
}


/*
 * 我们对require操作码的安全实现。
 * 这是安全的，因为它完全无法加载任何代码。
 * 如果请求的文件/模块已经被加载，它将返回true。
 * 如果没有，它将终止。
 * 因此，现在“use Foo;”只有在Foo已经被加载的情况下才会生效。
 */
static OP  *
fc_pp_require_safe(pTHX)
{
	dVAR;
	dSP;
	SV		   *fc_sv,
			  **fc_svp;
	char	   *fc_name;
	STRLEN		fc_len;

	fc_sv = POPs;
	fc_name = SvPV(fc_sv, fc_len);
	if (!(fc_name && fc_len > 0 && *fc_name))
		RETPUSHNO;

	fc_svp = hv_fetch(GvHVn(PL_incgv), fc_name, fc_len, 0);
	if (fc_svp && *fc_svp != &PL_sv_undef)
		RETPUSHYES;

	DIE(aTHX_ "Unable to load %s into plperl", fc_name);

	/*
	 * 在大多数Perl版本中，DIE()展开为返回语句，因此下一行不是必需的。
	 * 但是在5.11.1到5.13.3之间的版本中，它不是，因此下一行是必需的，以避免gcc的
	 * “控制到达非空函数的末尾”警告。其他编译器如Solaris Studio将发出“语句未被
	 * 达到”警告。
	 */
	return NULL;
}


/*
 * 销毁一个Perl解释器……实际上我们只是运行END块。
 *
 * 调用者必须确保这个解释器是活动的。
 */
static void fc_plperl_destroy_interp(PerlInterpreter **fc_interp)
{
	if (fc_interp && *fc_interp)
	{
		/*
		 * 执行的只是非常简单的销毁：- 只是调用END块。
		 *
		 * 我们可以调用perl_destruct()，但我们需要非常仔细地审查它的操作
		 * 并找出任何对我们有影响的工作。(调用sv_clean_objs()不是一个选项，因为它
		 * 不是perl的公共API的一部分，因此不可移植。)与此同时，END块可以
		 * 用于执行手动清理。
		 */
		dTHX;

		/* 运行END块 - 基于perl的perl_destruct() */
		if (PL_exit_flags & PERL_EXIT_DESTRUCT_END)
		{
			dJMPENV;
			int			fc_x = 0;

			JMPENV_PUSH(fc_x);
			PERL_UNUSED_VAR(fc_x);
			if (PL_endav && !PL_minus_c)
				call_list(PL_scopestack_ix, PL_endav);
			JMPENV_POP;
		}
		LEAVE;
		FREETMPS;

		*fc_interp = NULL;
	}
}

/*
 * 将当前Perl解释器初始化为一个受信任的解释器
 */
static void fc_plperl_trusted_init(void)
{
	dTHX;
	HV		   *fc_stash;
	SV		   *fc_sv;
	char	   *fc_key;
	I32			fc_klen;

	/* 在设置期间使用原始require */
	PL_ppaddr[OP_REQUIRE] = pp_require_orig;
	PL_ppaddr[OP_DOFILE] = pp_require_orig;

	eval_pv(PLC_TRUSTED, FALSE);
	if (SvTRUE(ERRSV))
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
				 errcontext("while executing PLC_TRUSTED")));

	/*
	 * 现在强制加载utf8模块，以防止后续的正则表达式代码尝试加载utf8模块
	 * 而引发错误。见http://rt.perl.org/rt3/Ticket/Display.html?id=47576
	 */
	eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
	if (SvTRUE(ERRSV))
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
				 errcontext("while executing utf8fix")));

	/*
	 * 锁定解释器
	 */

	/* 切换到安全的require/dofile操作码以供将后续代码使用 */
	PL_ppaddr[OP_REQUIRE] = fc_pp_require_safe;
	PL_ppaddr[OP_DOFILE] = fc_pp_require_safe;

	/*
	 * 防止（更多）不安全的操作码被编译，PL_op_mask是每个
	 * 解释器独立的，因此只需要设置一次
	 */
	PL_op_mask = plperl_opmask;

	/* 删除DynaLoader::命名空间，以便扩展无法被加载 */
	fc_stash = gv_stashpv("DynaLoader", GV_ADDWARN);
	hv_iterinit(fc_stash);
	while ((fc_sv = hv_iternextsv(fc_stash, &fc_key, &fc_klen)))
	{
		if (!isGV_with_GP(fc_sv) || !GvCV(fc_sv))
			continue;
		SvREFCNT_dec(GvCV(fc_sv)); /* 释放CV */
		GvCV_set(fc_sv, NULL);		/* 防止通过GV调用 */
	}
	hv_clear(fc_stash);

	/* 使各种缓存无效 */
	++PL_sub_generation;
	hv_clear(PL_stashcache);

	/*
	 * 在锁定的解释器中执行plperl.on_plperl_init
	 */
	if (plperl_on_plperl_init && *plperl_on_plperl_init)
	{
		eval_pv(plperl_on_plperl_init, FALSE);
		/* XXX 需要找到一种更好的方式来确定此处的错误代码 */
		if (SvTRUE(ERRSV))
			ereport(ERROR,
					(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
					 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
					 errcontext("while executing plperl.on_plperl_init")));
	}
}


/*
 * 将当前Perl解释器初始化为一个不受信任的解释器
 */
static void fc_plperl_untrusted_init(void)
{
	dTHX;

	/*
	 * 没什么可做的，只需执行plperl.on_plperlu_init
	 */
	if (plperl_on_plperlu_init && *plperl_on_plperlu_init)
	{
		eval_pv(plperl_on_plperlu_init, FALSE);
		if (SvTRUE(ERRSV))
			ereport(ERROR,
					(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
					 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV))),
					 errcontext("while executing plperl.on_plperlu_init")));
	}
}


/*
 * Perl喜欢在其错误消息后面放置换行符；清理这样
 */
static char * fc_strip_trailing_ws(const char *fc_msg)
{
	char	   *fc_res = pstrdup(fc_msg);
	int			fc_len = strlen(fc_res);

	while (fc_len > 0 && isspace((unsigned char) fc_res[fc_len - 1]))
		fc_res[--fc_len] = '\0';
	return fc_res;
}


/* 从哈希构建元组。 */

static HeapTuple fc_plperl_build_tuple_result(HV *fc_perlhash, TupleDesc fc_td)
{
	dTHX;
	Datum	   *fc_values;
	bool	   *fc_nulls;
	HE		   *fc_he;
	HeapTuple	fc_tup;

	fc_values = palloc0(sizeof(Datum) * fc_td->natts);
	fc_nulls = palloc(sizeof(bool) * fc_td->natts);
	memset(fc_nulls, true, sizeof(bool) * fc_td->natts);

	hv_iterinit(fc_perlhash);
	while ((fc_he = hv_iternext(fc_perlhash)))
	{
		SV		   *fc_val = HeVAL(fc_he);
		char	   *fc_key = fc_hek2cstr(fc_he);
		int			fc_attn = SPI_fnumber(fc_td, fc_key);
		Form_pg_attribute fc_attr = TupleDescAttr(fc_td, fc_attn - 1);

		if (fc_attn == SPI_ERROR_NOATTRIBUTE)
			ereport(ERROR,
					(errcode(ERRCODE_UNDEFINED_COLUMN),
					 errmsg("Perl hash contains nonexistent column \"%s\"",
							fc_key)));
		if (fc_attn <= 0)
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("cannot set system attribute \"%s\"",
							fc_key)));

		fc_values[fc_attn - 1] = fc_plperl_sv_to_datum(fc_val,
											  fc_attr->atttypid,
											  fc_attr->atttypmod,
											  NULL,
											  NULL,
											  InvalidOid,
											  &fc_nulls[fc_attn - 1]);

		pfree(fc_key);
	}
	hv_iterinit(fc_perlhash);

	fc_tup = heap_form_tuple(fc_td, fc_values, fc_nulls);
	pfree(fc_values);
	pfree(fc_nulls);
	return fc_tup;
}

/* 将哈希引用转换为数据 */
static Datum fc_plperl_hash_to_datum(SV *fc_src, TupleDesc fc_td)
{
	HeapTuple	fc_tup = fc_plperl_build_tuple_result((HV *) SvRV(fc_src), fc_td);

	return HeapTupleGetDatum(fc_tup);
}

/*
 * 如果我们是数组引用，返回该引用。这是特别的，因为如果我们
 * 是一个PostgreSQL::InServer::ARRAY对象，我们将返回“魔法”数组。
 */
static SV  * fc_get_perl_array_ref(SV *fc_sv)
{
	dTHX;

	if (SvOK(fc_sv) && SvROK(fc_sv))
	{
		if (SvTYPE(SvRV(fc_sv)) == SVt_PVAV)
			return fc_sv;
		else if (sv_isa(fc_sv, "PostgreSQL::InServer::ARRAY"))
		{
			HV		   *fc_hv = (HV *) SvRV(fc_sv);
			SV		  **fc_sav = fc_hv_fetch_string(fc_hv, "array");

			if (*fc_sav && SvOK(*fc_sav) && SvROK(*fc_sav) &&
				SvTYPE(SvRV(*fc_sav)) == SVt_PVAV)
				return *fc_sav;

			elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
		}
	}
	return NULL;
}

/*
 * plperl_array_to_datum的助手函数，为多维数组递归
 *
 * 仅在第一次找到标量元素时创建ArrayBuildState；
 * 如果我们不这样做，则需要其他约定来知道
 * 我们是否已经找到了任何标量（以及因此维度的数量
 * 是固定的）。
 */
static void fc_array_to_datum_internal(AV *fc_av, ArrayBuildState **fc_astatep,
						int *fc_ndims, int *fc_dims, int fc_cur_depth,
						Oid fc_elemtypid, int32 fc_typmod,
						FmgrInfo *fc_finfo, Oid fc_typioparam)
{
	dTHX;
	int			fc_i;
	int			fc_len = av_len(fc_av) + 1;

	for (fc_i = 0; fc_i < fc_len; fc_i++)
	{
		/* 获取数组元素 */
		SV		  **fc_svp = av_fetch(fc_av, fc_i, FALSE);

		/* 查看这个元素是否是数组，如果是则获取该数组 */
		SV		   *fc_sav = fc_svp ? fc_get_perl_array_ref(*fc_svp) : NULL;

		/* 多维数组？ */
		if (fc_sav)
		{
			AV		   *fc_nav = (AV *) SvRV(fc_sav);

			/* 在此层的第一个元素设置大小，否则进行比较 */
			if (fc_i == 0 && *fc_ndims == fc_cur_depth)
			{
				/* 在同一层次中有一些标量之后的数组？ */
				if (*fc_astatep != NULL)
					ereport(ERROR,
							(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
							 errmsg("multidimensional arrays must have array expressions with matching dimensions")));
				/* 太多维度？ */
				if (fc_cur_depth + 1 > MAXDIM)
					ereport(ERROR,
							(errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
							 errmsg("number of array dimensions (%d) exceeds the maximum allowed (%d)",
									fc_cur_depth + 1, MAXDIM)));
				/* 好吧，添加一个维度 */
				fc_dims[*fc_ndims] = av_len(fc_nav) + 1;
				(*fc_ndims)++;
			}
			else if (fc_cur_depth >= *fc_ndims ||
					 av_len(fc_nav) + 1 != fc_dims[fc_cur_depth])
				ereport(ERROR,
						(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
						 errmsg("multidimensional arrays must have array expressions with matching dimensions")));

			/* 递归以获取此子数组的元素 */
			fc_array_to_datum_internal(fc_nav, fc_astatep,
									fc_ndims, fc_dims, fc_cur_depth + 1,
									fc_elemtypid, fc_typmod,
									fc_finfo, fc_typioparam);
		}
		else
		{
			Datum		fc_dat;
			bool		fc_isnull;

			/* 在同一层级之后有标量吗？ */
			if (*fc_ndims != fc_cur_depth)
				ereport(ERROR,
						(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
						 errmsg("multidimensional arrays must have array expressions with matching dimensions")));

			fc_dat = fc_plperl_sv_to_datum(fc_svp ? *fc_svp : NULL,
									 fc_elemtypid,
									 fc_typmod,
									 NULL,
									 fc_finfo,
									 fc_typioparam,
									 &fc_isnull);

			/* 如果我们还没有，就创建 ArrayBuildState */
			if (*fc_astatep == NULL)
				*fc_astatep = initArrayResult(fc_elemtypid,
										   CurrentMemoryContext, true);

			/* ... 并将元素值保存在其中 */
			(void) accumArrayResult(*fc_astatep, fc_dat, fc_isnull,
									fc_elemtypid, CurrentMemoryContext);
		}
	}
}

/*
 * 将 perl 数组引用转换为数据项
 */
static Datum fc_plperl_array_to_datum(SV *fc_src, Oid fc_typid, int32 fc_typmod)
{
	dTHX;
	AV		   *fc_nav = (AV *) SvRV(fc_src);
	ArrayBuildState *fc_astate = NULL;
	Oid			fc_elemtypid;
	FmgrInfo	fc_finfo;
	Oid			fc_typioparam;
	int			fc_dims[MAXDIM];
	int			fc_lbs[MAXDIM];
	int			fc_ndims = 1;
	int			fc_i;

	fc_elemtypid = get_element_type(fc_typid);
	if (!fc_elemtypid)
		ereport(ERROR,
				(errcode(ERRCODE_DATATYPE_MISMATCH),
				 errmsg("cannot convert Perl array to non-array type %s",
						format_type_be(fc_typid))));

	fc__sv_to_datum_finfo(fc_elemtypid, &fc_finfo, &fc_typioparam);

	memset(fc_dims, 0, sizeof(fc_dims));
	fc_dims[0] = av_len(fc_nav) + 1;

	fc_array_to_datum_internal(fc_nav, &fc_astate,
							&fc_ndims, fc_dims, 1,
							fc_elemtypid, fc_typmod,
							&fc_finfo, fc_typioparam);

	/* 确保在没有输入的情况下获得零维数组，符合 PG 约定 */
	if (fc_astate == NULL)
		return PointerGetDatum(construct_empty_array(fc_elemtypid));

	for (fc_i = 0; fc_i < fc_ndims; fc_i++)
		fc_lbs[fc_i] = 1;

	return makeMdArrayResult(fc_astate, fc_ndims, fc_dims, fc_lbs,
							 CurrentMemoryContext, true);
}

/* 获取将数据转换为指定 PG 类型所需的信息 */
static void fc__sv_to_datum_finfo(Oid fc_typid, FmgrInfo *fc_finfo, Oid *fc_typioparam)
{
	Oid			fc_typinput;

	/* XXX 最好缓存这些查找 */
	getTypeInputInfo(fc_typid,
					 &fc_typinput, fc_typioparam);
	fmgr_info(fc_typinput, fc_finfo);
}

/*
 * 将 Perl SV 转换为类型 typid 的 PG 数据项，typmod typmod
 *
 * 在尝试转换为函数结果类型时传递 PL/Perl 函数的 fcinfo；否则传递 NULL。这在需要解析返回 RECORD 的函数的实际结果类型时使用。
 *
 * finfo 和 typioparam 应该是给定 typid 的 _sv_to_datum_finfo 的结果，或 NULL/InvalidOid 以让此函数进行查找。
 *
 * *isnull 是一个输出参数。
 */
static Datum fc_plperl_sv_to_datum(SV *fc_sv, Oid fc_typid, int32 fc_typmod,
				   FunctionCallInfo fc_fcinfo,
				   FmgrInfo *fc_finfo, Oid fc_typioparam,
				   bool *fc_isnull)
{
	FmgrInfo	fc_tmp;
	Oid			fc_funcid;

	/* 我们可能会递归 */
	check_stack_depth();

	*fc_isnull = false;

	/*
	 * 如果结果是 undef，或者我们在返回 VOID 的函数中，返回 NULL。在后一种情况下，我们不应该关注最后一个 Perl 语句的结果，这是一种确保的方便手段。
	 */
	if (!fc_sv || !SvOK(fc_sv) || fc_typid == VOIDOID)
	{
		/* 如果未传递类型信息，则查找类型信息 */
		if (!fc_finfo)
		{
			fc__sv_to_datum_finfo(fc_typid, &fc_tmp, &fc_typioparam);
			fc_finfo = &fc_tmp;
		}
		*fc_isnull = true;
		/* 必须调用 typinput 以防它想要拒绝 NULL */
		return InputFunctionCall(fc_finfo, NULL, fc_typioparam, fc_typmod);
	}
	else if ((fc_funcid = get_transform_tosql(fc_typid, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
		return OidFunctionCall1(fc_funcid, PointerGetDatum(fc_sv));
	else if (SvROK(fc_sv))
	{
		/* 处理引用 */
		SV		   *fc_sav = fc_get_perl_array_ref(fc_sv);

		if (fc_sav)
		{
			/* 处理数组引用 */
			return fc_plperl_array_to_datum(fc_sav, fc_typid, fc_typmod);
		}
		else if (SvTYPE(SvRV(fc_sv)) == SVt_PVHV)
		{
			/* 处理哈希引用 */
			Datum		fc_ret;
			TupleDesc	fc_td;
			bool		fc_isdomain;

			if (!type_is_rowtype(fc_typid))
				ereport(ERROR,
						(errcode(ERRCODE_DATATYPE_MISMATCH),
						 errmsg("cannot convert Perl hash to non-composite type %s",
								format_type_be(fc_typid))));

			fc_td = lookup_rowtype_tupdesc_domain(fc_typid, fc_typmod, true);
			if (fc_td != NULL)
			{
				/* 我们是否查看了域？ */
				fc_isdomain = (fc_typid != fc_td->tdtypeid);
			}
			else
			{
				/* 必须是 RECORD，尝试根据调用信息解析 */
				TypeFuncClass fc_funcclass;

				if (fc_fcinfo)
					fc_funcclass = get_call_result_type(fc_fcinfo, &fc_typid, &fc_td);
				else
					fc_funcclass = TYPEFUNC_OTHER;
				if (fc_funcclass != TYPEFUNC_COMPOSITE &&
					fc_funcclass != TYPEFUNC_COMPOSITE_DOMAIN)
					ereport(ERROR,
							(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
							 errmsg("function returning record called in context "
									"that cannot accept type record")));
				Assert(fc_td);
				fc_isdomain = (fc_funcclass == TYPEFUNC_COMPOSITE_DOMAIN);
			}

			fc_ret = fc_plperl_hash_to_datum(fc_sv, fc_td);

			if (fc_isdomain)
				domain_check(fc_ret, false, fc_typid, NULL, NULL);

			/* 从 get_call_result_type 的结果中释放没有害处 */
			ReleaseTupleDesc(fc_td);

			return fc_ret;
		}

		/*
		 * 如果它是对其他东西的引用，比如标量，只需递归地查看该引用。
		 */
		return fc_plperl_sv_to_datum(SvRV(fc_sv), fc_typid, fc_typmod,
								  fc_fcinfo, fc_finfo, fc_typioparam,
								  fc_isnull);
	}
	else
	{
		/* 处理字符串/数字 */
		Datum		fc_ret;
		char	   *fc_str = sv2cstr(fc_sv);

		/* 没有传入任何类型信息？查找它 */
		if (!fc_finfo)
		{
			fc__sv_to_datum_finfo(fc_typid, &fc_tmp, &fc_typioparam);
			fc_finfo = &fc_tmp;
		}

		fc_ret = InputFunctionCall(fc_finfo, fc_str, fc_typioparam, fc_typmod);
		pfree(fc_str);

		return fc_ret;
	}
}

/* 将 perl SV 转换为类型输出函数返回的字符串 */
char * plperl_sv_to_literal(SV *fc_sv, char *fc_fqtypename)
{
	Oid			fc_typid;
	Oid			fc_typoutput;
	Datum		fc_datum;
	bool		fc_typisvarlena,
				fc_isnull;

	fc_check_spi_usage_allowed();

	fc_typid = DirectFunctionCall1(regtypein, CStringGetDatum(fc_fqtypename));
	if (!OidIsValid(fc_typid))
		ereport(ERROR,
				(errcode(ERRCODE_UNDEFINED_OBJECT),
				 errmsg("lookup failed for type %s", fc_fqtypename)));

	fc_datum = fc_plperl_sv_to_datum(fc_sv,
							   fc_typid, -1,
							   NULL, NULL, InvalidOid,
							   &fc_isnull);

	if (fc_isnull)
		return NULL;

	getTypeOutputInfo(fc_typid,
					  &fc_typoutput, &fc_typisvarlena);

	return OidOutputFunctionCall(fc_typoutput, fc_datum);
}

/*
 * 将 PostgreSQL 数组数据项转换为 perl 数组引用。
 *
 * typid 是参数的 OID，必须是数组类型。
 */
static SV  * fc_plperl_ref_from_pg_array(Datum fc_arg, Oid fc_typid)
{
	dTHX;
	ArrayType  *fc_ar = DatumGetArrayTypeP(fc_arg);
	Oid			fc_elementtype = ARR_ELEMTYPE(fc_ar);
	int16		fc_typlen;
	bool		fc_typbyval;
	char		fc_typalign,
				fc_typdelim;
	Oid			fc_typioparam;
	Oid			fc_typoutputfunc;
	Oid			fc_transform_funcid;
	int			fc_i,
				fc_nitems,
			   *fc_dims;
	plperl_array_info *fc_info;
	SV		   *fc_av;
	HV		   *fc_hv;

	/*
	 * 当前我们没有努力缓存我们在这里查找的任何内容，这是不好的。
	 */
	fc_info = palloc0(sizeof(plperl_array_info));

	/* 获取元素类型信息，包括输出转换函数 */
	get_type_io_data(fc_elementtype, IOFunc_output,
					 &fc_typlen, &fc_typbyval, &fc_typalign,
					 &fc_typdelim, &fc_typioparam, &fc_typoutputfunc);

	/* 检查转换函数 */
	fc_transform_funcid = get_transform_fromsql(fc_elementtype,
											 current_call_data->prodesc->lang_oid,
											 current_call_data->prodesc->trftypes);

	/* 适当时查找转换或输出函数 */
	if (OidIsValid(fc_transform_funcid))
		fmgr_info(fc_transform_funcid, &fc_info->transform_proc);
	else
		fmgr_info(fc_typoutputfunc, &fc_info->proc);

	fc_info->elem_is_rowtype = type_is_rowtype(fc_elementtype);

	/* 获取数组维度的数量和边界 */
	fc_info->ndims = ARR_NDIM(fc_ar);
	fc_dims = ARR_DIMS(fc_ar);

	/* 没有维度？返回一个空数组 */
	if (fc_info->ndims == 0)
	{
		fc_av = newRV_noinc((SV *) newAV());
	}
	else
	{
		deconstruct_array(fc_ar, fc_elementtype, fc_typlen, fc_typbyval,
						  fc_typalign, &fc_info->elements, &fc_info->nulls,
						  &fc_nitems);

		/* 获取每个维度中元素的总数 */
		fc_info->nelems = palloc(sizeof(int) * fc_info->ndims);
		fc_info->nelems[0] = fc_nitems;
		for (fc_i = 1; fc_i < fc_info->ndims; fc_i++)
			fc_info->nelems[fc_i] = fc_info->nelems[fc_i - 1] / fc_dims[fc_i - 1];

		fc_av = fc_split_array(fc_info, 0, fc_nitems, 0);
	}

	fc_hv = newHV();
	(void) hv_store(fc_hv, "array", 5, fc_av, 0);
	(void) hv_store(fc_hv, "typeoid", 7, newSVuv(fc_typid), 0);

	return sv_bless(newRV_noinc((SV *) fc_hv),
					gv_stashpv("PostgreSQL::InServer::ARRAY", 0));
}

/*
 * 从初始数组的拼接中递归形成数组引用
 */
static SV  * fc_split_array(plperl_array_info *fc_info, int fc_first, int fc_last, int fc_nest)
{
	dTHX;
	int			fc_i;
	AV		   *fc_result;

	/* 应该只在我们有东西要分割时调用 */
	Assert(fc_info->ndims > 0);

	/* 由于这个函数递归，可能会导致栈溢出 */
	check_stack_depth();

	/*
	 * 基本情况，返回对单维数组的引用
	 */
	if (fc_nest >= fc_info->ndims - 1)
		return fc_make_array_ref(fc_info, fc_first, fc_last);

	fc_result = newAV();
	for (fc_i = fc_first; fc_i < fc_last; fc_i += fc_info->nelems[fc_nest + 1])
	{
		/* 递归形成对低维数组的引用 */
		SV		   *fc_ref = fc_split_array(fc_info, fc_i, fc_i + fc_info->nelems[fc_nest + 1], fc_nest + 1);

		av_push(fc_result, fc_ref);
	}
	return newRV_noinc((SV *) fc_result);
}

/*
 * 从一维C数组创建一个Perl引用，将复合类型元素转换为哈希引用。
 */
static SV  * fc_make_array_ref(plperl_array_info *fc_info, int fc_first, int fc_last)
{
	dTHX;
	int			fc_i;
	AV		   *fc_result = newAV();

	for (fc_i = fc_first; fc_i < fc_last; fc_i++)
	{
		if (fc_info->nulls[fc_i])
		{
			/*
			 * 我们不能在这里使用 &PL_sv_undef。请参见 perlguts 中的 "AVs, HVs and undefined values"。
			 */
			av_push(fc_result, newSV(0));
		}
		else
		{
			Datum		fc_itemvalue = fc_info->elements[fc_i];

			if (fc_info->transform_proc.fn_oid)
				av_push(fc_result, (SV *) DatumGetPointer(FunctionCall1(&fc_info->transform_proc, fc_itemvalue)));
			else if (fc_info->elem_is_rowtype)
				/* 处理复合类型元素 */
				av_push(fc_result, fc_plperl_hash_from_datum(fc_itemvalue));
			else
			{
				char	   *fc_val = OutputFunctionCall(&fc_info->proc, fc_itemvalue);

				av_push(fc_result, cstr2sv(fc_val));
			}
		}
	}
	return newRV_noinc((SV *) fc_result);
}

/* 为触发器调用设置参数。 */
static SV  * fc_plperl_trigger_build_args(FunctionCallInfo fc_fcinfo)
{
	dTHX;
	TriggerData *fc_tdata;
	TupleDesc	fc_tupdesc;
	int			fc_i;
	char	   *fc_level;
	char	   *fc_event;
	char	   *fc_relid;
	char	   *fc_when;
	HV		   *fc_hv;

	fc_hv = newHV();
	hv_ksplit(fc_hv, 12);			/* 预先扩展哈希 */

	fc_tdata = (TriggerData *) fc_fcinfo->context;
	fc_tupdesc = fc_tdata->tg_relation->rd_att;

	fc_relid = DatumGetCString(DirectFunctionCall1(oidout,
												ObjectIdGetDatum(fc_tdata->tg_relation->rd_id)));

	fc_hv_store_string(fc_hv, "name", cstr2sv(fc_tdata->tg_trigger->tgname));
	fc_hv_store_string(fc_hv, "relid", cstr2sv(fc_relid));

	/*
	 * 注意：在BEFORE触发器中，存储的生成列尚未计算，
	 * 因此不要在NEW行中使其可访问。
	 */

	if (TRIGGER_FIRED_BY_INSERT(fc_tdata->tg_event))
	{
		fc_event = "INSERT";
		if (TRIGGER_FIRED_FOR_ROW(fc_tdata->tg_event))
			fc_hv_store_string(fc_hv, "new",
							fc_plperl_hash_from_tuple(fc_tdata->tg_trigtuple,
												   fc_tupdesc,
												   !TRIGGER_FIRED_BEFORE(fc_tdata->tg_event)));
	}
	else if (TRIGGER_FIRED_BY_DELETE(fc_tdata->tg_event))
	{
		fc_event = "DELETE";
		if (TRIGGER_FIRED_FOR_ROW(fc_tdata->tg_event))
			fc_hv_store_string(fc_hv, "old",
							fc_plperl_hash_from_tuple(fc_tdata->tg_trigtuple,
												   fc_tupdesc,
												   true));
	}
	else if (TRIGGER_FIRED_BY_UPDATE(fc_tdata->tg_event))
	{
		fc_event = "UPDATE";
		if (TRIGGER_FIRED_FOR_ROW(fc_tdata->tg_event))
		{
			fc_hv_store_string(fc_hv, "old",
							fc_plperl_hash_from_tuple(fc_tdata->tg_trigtuple,
												   fc_tupdesc,
												   true));
			fc_hv_store_string(fc_hv, "new",
							fc_plperl_hash_from_tuple(fc_tdata->tg_newtuple,
												   fc_tupdesc,
												   !TRIGGER_FIRED_BEFORE(fc_tdata->tg_event)));
		}
	}
	else if (TRIGGER_FIRED_BY_TRUNCATE(fc_tdata->tg_event))
		fc_event = "TRUNCATE";
	else
		fc_event = "UNKNOWN";

	fc_hv_store_string(fc_hv, "event", cstr2sv(fc_event));
	fc_hv_store_string(fc_hv, "argc", newSViv(fc_tdata->tg_trigger->tgnargs));

	if (fc_tdata->tg_trigger->tgnargs > 0)
	{
		AV		   *fc_av = newAV();

		av_extend(fc_av, fc_tdata->tg_trigger->tgnargs);
		for (fc_i = 0; fc_i < fc_tdata->tg_trigger->tgnargs; fc_i++)
			av_push(fc_av, cstr2sv(fc_tdata->tg_trigger->tgargs[fc_i]));
		fc_hv_store_string(fc_hv, "args", newRV_noinc((SV *) fc_av));
	}

	fc_hv_store_string(fc_hv, "relname",
					cstr2sv(SPI_getrelname(fc_tdata->tg_relation)));

	fc_hv_store_string(fc_hv, "table_name",
					cstr2sv(SPI_getrelname(fc_tdata->tg_relation)));

	fc_hv_store_string(fc_hv, "table_schema",
					cstr2sv(SPI_getnspname(fc_tdata->tg_relation)));

	if (TRIGGER_FIRED_BEFORE(fc_tdata->tg_event))
		fc_when = "BEFORE";
	else if (TRIGGER_FIRED_AFTER(fc_tdata->tg_event))
		fc_when = "AFTER";
	else if (TRIGGER_FIRED_INSTEAD(fc_tdata->tg_event))
		fc_when = "INSTEAD OF";
	else
		fc_when = "UNKNOWN";
	fc_hv_store_string(fc_hv, "when", cstr2sv(fc_when));

	if (TRIGGER_FIRED_FOR_ROW(fc_tdata->tg_event))
		fc_level = "ROW";
	else if (TRIGGER_FIRED_FOR_STATEMENT(fc_tdata->tg_event))
		fc_level = "STATEMENT";
	else
		fc_level = "UNKNOWN";
	fc_hv_store_string(fc_hv, "level", cstr2sv(fc_level));

	return newRV_noinc((SV *) fc_hv);
}


/* 为事件触发器调用设置参数。 */
static SV  * fc_plperl_event_trigger_build_args(FunctionCallInfo fc_fcinfo)
{
	dTHX;
	EventTriggerData *fc_tdata;
	HV		   *fc_hv;

	fc_hv = newHV();

	fc_tdata = (EventTriggerData *) fc_fcinfo->context;

	fc_hv_store_string(fc_hv, "event", cstr2sv(fc_tdata->event));
	fc_hv_store_string(fc_hv, "tag", cstr2sv(GetCommandTagName(fc_tdata->tag)));

	return newRV_noinc((SV *) fc_hv);
}

/* 构造从触发器返回的修改后的新元组。 */
static HeapTuple fc_plperl_modify_tuple(HV *fc_hvTD, TriggerData *fc_tdata, HeapTuple fc_otup)
{
	dTHX;
	SV		  **fc_svp;
	HV		   *fc_hvNew;
	HE		   *fc_he;
	HeapTuple	fc_rtup;
	TupleDesc	fc_tupdesc;
	int			fc_natts;
	Datum	   *fc_modvalues;
	bool	   *fc_modnulls;
	bool	   *fc_modrepls;

	fc_svp = fc_hv_fetch_string(fc_hvTD, "new");
	if (!fc_svp)
		ereport(ERROR,
				(errcode(ERRCODE_UNDEFINED_COLUMN),
				 errmsg("$_TD->{new} does not exist")));
	if (!SvOK(*fc_svp) || !SvROK(*fc_svp) || SvTYPE(SvRV(*fc_svp)) != SVt_PVHV)
		ereport(ERROR,
				(errcode(ERRCODE_DATATYPE_MISMATCH),
				 errmsg("$_TD->{new} is not a hash reference")));
	fc_hvNew = (HV *) SvRV(*fc_svp);

	fc_tupdesc = fc_tdata->tg_relation->rd_att;
	fc_natts = fc_tupdesc->natts;

	fc_modvalues = (Datum *) palloc0(fc_natts * sizeof(Datum));
	fc_modnulls = (bool *) palloc0(fc_natts * sizeof(bool));
	fc_modrepls = (bool *) palloc0(fc_natts * sizeof(bool));

	hv_iterinit(fc_hvNew);
	while ((fc_he = hv_iternext(fc_hvNew)))
	{
		char	   *fc_key = fc_hek2cstr(fc_he);
		SV		   *fc_val = HeVAL(fc_he);
		int			fc_attn = SPI_fnumber(fc_tupdesc, fc_key);
		Form_pg_attribute fc_attr = TupleDescAttr(fc_tupdesc, fc_attn - 1);

		if (fc_attn == SPI_ERROR_NOATTRIBUTE)
			ereport(ERROR,
					(errcode(ERRCODE_UNDEFINED_COLUMN),
					 errmsg("Perl hash contains nonexistent column \"%s\"",
							fc_key)));
		if (fc_attn <= 0)
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("cannot set system attribute \"%s\"",
							fc_key)));
		if (fc_attr->attgenerated)
			ereport(ERROR,
					(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
					 errmsg("cannot set generated column \"%s\"",
							fc_key)));

		fc_modvalues[fc_attn - 1] = fc_plperl_sv_to_datum(fc_val,
												 fc_attr->atttypid,
												 fc_attr->atttypmod,
												 NULL,
												 NULL,
												 InvalidOid,
												 &fc_modnulls[fc_attn - 1]);
		fc_modrepls[fc_attn - 1] = true;

		pfree(fc_key);
	}
	hv_iterinit(fc_hvNew);

	fc_rtup = heap_modify_tuple(fc_otup, fc_tupdesc, fc_modvalues, fc_modnulls, fc_modrepls);

	pfree(fc_modvalues);
	pfree(fc_modnulls);
	pfree(fc_modrepls);

	return fc_rtup;
}


/*
 * plperl有三个外部可见的部分：plperl_call_handler,
 * plperl_inline_handler和plperl_validator。
 */

/*
 * 调用处理程序用于运行在pg_proc中定义的正常函数
 * （包括触发器函数）。
 */
PG_FUNCTION_INFO_V1(plperl_call_handler);

Datum plperl_call_handler(PG_FUNCTION_ARGS)
{
	Datum		fc_retval = (Datum) 0;
	plperl_call_data *volatile fc_save_call_data = current_call_data;
	plperl_interp_desc *volatile fc_oldinterp = plperl_active_interp;
	plperl_call_data fc_this_call_data;

	/* 初始化当前调用状态记录 */
	MemSet(&fc_this_call_data, 0, sizeof(fc_this_call_data));
	fc_this_call_data.fcinfo = fcinfo;

	PG_TRY();
	{
		current_call_data = &fc_this_call_data;
		if (CALLED_AS_TRIGGER(fcinfo))
			fc_retval = PointerGetDatum(fc_plperl_trigger_handler(fcinfo));
		else if (CALLED_AS_EVENT_TRIGGER(fcinfo))
		{
			fc_plperl_event_trigger_handler(fcinfo);
			fc_retval = (Datum) 0;
		}
		else
			fc_retval = fc_plperl_func_handler(fcinfo);
	}
	PG_FINALLY();
	{
		current_call_data = fc_save_call_data;
		fc_activate_interpreter(fc_oldinterp);
		if (fc_this_call_data.prodesc)
			decrement_prodesc_refcount(fc_this_call_data.prodesc);
	}
	PG_END_TRY();

	return fc_retval;
}

/*
 * 内联处理程序运行匿名代码块（DO块）。
 */
PG_FUNCTION_INFO_V1(plperl_inline_handler);

Datum plperl_inline_handler(PG_FUNCTION_ARGS)
{
	LOCAL_FCINFO(fc_fake_fcinfo, 0);
	InlineCodeBlock *fc_codeblock = (InlineCodeBlock *) PG_GETARG_POINTER(0);
	FmgrInfo	fc_flinfo;
	plperl_proc_desc fc_desc;
	plperl_call_data *volatile fc_save_call_data = current_call_data;
	plperl_interp_desc *volatile fc_oldinterp = plperl_active_interp;
	plperl_call_data fc_this_call_data;
	ErrorContextCallback fc_pl_error_context;

	/* 初始化当前调用状态记录 */
	MemSet(&fc_this_call_data, 0, sizeof(fc_this_call_data));

	/* 为错误报告设置回调 */
	fc_pl_error_context.callback = fc_plperl_inline_callback;
	fc_pl_error_context.previous = error_context_stack;
	fc_pl_error_context.arg = NULL;
	error_context_stack = &fc_pl_error_context;

	/*
	 * 设置一个虚假的fcinfo和描述符，仅使用足够的信息来满足
	 * plperl_call_perl_func()。尤其注意，这在没有传递参数的情况下进行设置，
	 * 并且结果类型为VOID。
	 */
	MemSet(fc_fake_fcinfo, 0, SizeForFunctionCallInfo(0));
	MemSet(&fc_flinfo, 0, sizeof(fc_flinfo));
	MemSet(&fc_desc, 0, sizeof(fc_desc));
	fc_fake_fcinfo->flinfo = &fc_flinfo;
	fc_flinfo.fn_oid = InvalidOid;
	fc_flinfo.fn_mcxt = CurrentMemoryContext;

	fc_desc.proname = "inline_code_block";
	fc_desc.fn_readonly = false;

	fc_desc.lang_oid = fc_codeblock->langOid;
	fc_desc.trftypes = NIL;
	fc_desc.lanpltrusted = fc_codeblock->langIsTrusted;

	fc_desc.fn_retistuple = false;
	fc_desc.fn_retisset = false;
	fc_desc.fn_retisarray = false;
	fc_desc.result_oid = InvalidOid;
	fc_desc.nargs = 0;
	fc_desc.reference = NULL;

	fc_this_call_data.fcinfo = fc_fake_fcinfo;
	fc_this_call_data.prodesc = &fc_desc;
	/* 我们不处理虚假prodesc的引用计数 */

	PG_TRY();
	{
		SV		   *fc_perlret;

		current_call_data = &fc_this_call_data;

		if (SPI_connect_ext(fc_codeblock->atomic ? 0 : SPI_OPT_NONATOMIC) != SPI_OK_CONNECT)
			elog(ERROR, "could not connect to SPI manager");

		fc_select_perl_context(fc_desc.lanpltrusted);

		fc_plperl_create_sub(&fc_desc, fc_codeblock->source_text, 0);

		if (!fc_desc.reference)	/* 这可能发生吗？ */
			elog(ERROR, "could not create internal procedure for anonymous code block");

		fc_perlret = fc_plperl_call_perl_func(&fc_desc, fc_fake_fcinfo);

		fc_SvREFCNT_dec_current(fc_perlret);

		if (SPI_finish() != SPI_OK_FINISH)
			elog(ERROR, "SPI_finish() failed");
	}
	PG_FINALLY();
	{
		if (fc_desc.reference)
			fc_SvREFCNT_dec_current(fc_desc.reference);
		current_call_data = fc_save_call_data;
		fc_activate_interpreter(fc_oldinterp);
	}
	PG_END_TRY();

	error_context_stack = fc_pl_error_context.previous;

	PG_RETURN_VOID();
}

/*
 * 验证程序在CREATE FUNCTION期间被调用，以验证正在创建/替换的函数。
 * 验证器的精确行为可以通过check_function_bodies GUC进行修改。
 */
PG_FUNCTION_INFO_V1(plperl_validator);

Datum plperl_validator(PG_FUNCTION_ARGS)
{
	Oid			fc_funcoid = PG_GETARG_OID(0);
	HeapTuple	fc_tuple;
	Form_pg_proc fc_proc;
	char		fc_functyptype;
	int			fc_numargs;
	Oid		   *fc_argtypes;
	char	  **fc_argnames;
	char	   *fc_argmodes;
	bool		fc_is_trigger = false;
	bool		fc_is_event_trigger = false;
	int			fc_i;

	if (!CheckFunctionValidatorAccess(fcinfo->flinfo->fn_oid, fc_funcoid))
		PG_RETURN_VOID();

	/* 获取新函数的pg_proc条目 */
	fc_tuple = SearchSysCache1(PROCOID, ObjectIdGetDatum(fc_funcoid));
	if (!HeapTupleIsValid(fc_tuple))
		elog(ERROR, "cache lookup failed for function %u", fc_funcoid);
	fc_proc = (Form_pg_proc) GETSTRUCT(fc_tuple);

	fc_functyptype = get_typtype(fc_proc->prorettype);

	/* 不允许伪类型结果 */
	/* 除非是TRIGGER, EVTTRIGGER, RECORD或VOID */
	if (fc_functyptype == TYPTYPE_PSEUDO)
	{
		if (fc_proc->prorettype == TRIGGEROID)
			fc_is_trigger = true;
		else if (fc_proc->prorettype == EVENT_TRIGGEROID)
			fc_is_event_trigger = true;
		else if (fc_proc->prorettype != RECORDOID &&
				 fc_proc->prorettype != VOIDOID)
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("PL/Perl functions cannot return type %s",
							format_type_be(fc_proc->prorettype))));
	}

	/* 不允许在参数中使用伪类型（无论是IN还是OUT） */
	fc_numargs = get_func_arg_info(fc_tuple,
								&fc_argtypes, &fc_argnames, &fc_argmodes);
	for (fc_i = 0; fc_i < fc_numargs; fc_i++)
	{
		if (get_typtype(fc_argtypes[fc_i]) == TYPTYPE_PSEUDO &&
			fc_argtypes[fc_i] != RECORDOID)
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("PL/Perl functions cannot accept type %s",
							format_type_be(fc_argtypes[fc_i]))));
	}

	ReleaseSysCache(fc_tuple);

	/* 如果!check_function_bodies则推迟主体检查 */
	if (check_function_bodies)
	{
		(void) fc_compile_plperl_function(fc_funcoid, fc_is_trigger, fc_is_event_trigger);
	}

	/* 验证器的结果被忽略 */
	PG_RETURN_VOID();
}


/*
 * plperlu同样要求三个外部可见的函数：
 * plperlu_call_handler, plperlu_inline_handler和plperlu_validator。
 * 这些函数当前只是将控制权发送到plperl处理函数的别名，
 * 我们通过检查实际的pg_language元组来判断特定函数是否被信任。
 */

PG_FUNCTION_INFO_V1(plperlu_call_handler);

Datum plperlu_call_handler(PG_FUNCTION_ARGS)
{
	return plperl_call_handler(fcinfo);
}

PG_FUNCTION_INFO_V1(plperlu_inline_handler);

Datum plperlu_inline_handler(PG_FUNCTION_ARGS)
{
	return plperl_inline_handler(fcinfo);
}

PG_FUNCTION_INFO_V1(plperlu_validator);

Datum plperlu_validator(PG_FUNCTION_ARGS)
{
	/* 使用我们的fcinfo调用plperl验证器，以便它获取我们的oid */
	return plperl_validator(fcinfo);
}


/*
 * 使用mkfunc创建一个子例程，其文本在s中提供，并返回对它的引用
 */
static void fc_plperl_create_sub(plperl_proc_desc *fc_prodesc, const char *fc_s, Oid fc_fn_oid)
{
	dTHX;
	dSP;
	char		fc_subname[NAMEDATALEN + 40];
	HV		   *fc_pragma_hv = newHV();
	SV		   *fc_subref = NULL;
	int			fc_count;

	sprintf(fc_subname, "%s__%u", fc_prodesc->proname, fc_fn_oid);

	if (plperl_use_strict)
		fc_hv_store_string(fc_pragma_hv, "strict", (SV *) newAV());

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	EXTEND(SP, 4);
	PUSHs(sv_2mortal(cstr2sv(fc_subname)));
	PUSHs(sv_2mortal(newRV_noinc((SV *) fc_pragma_hv)));

	/*
	 * 在mkfunc中使用'false'作为$prolog，这保留是为了兼容性，
	 * 以防像PostgreSQL::PLPerl::NYTprof这样的模块替换函数编译器。
	 */
	PUSHs(&PL_sv_no);
	PUSHs(sv_2mortal(cstr2sv(fc_s)));
	PUTBACK;

	/*
	 * G_KEEPERR似乎在这里是必要的，否则我们无法正确识别编译错误。
	 * 也许是因为在mksafefunc内部还有另一个eval级别？
	 */
	fc_count = call_pv("PostgreSQL::InServer::mkfunc",
					G_SCALAR | G_EVAL | G_KEEPERR);
	SPAGAIN;

	if (fc_count == 1)
	{
		SV		   *fc_sub_rv = (SV *) POPs;

		if (fc_sub_rv && SvROK(fc_sub_rv) && SvTYPE(SvRV(fc_sub_rv)) == SVt_PVCV)
		{
			fc_subref = newRV_inc(SvRV(fc_sub_rv));
		}
	}

	PUTBACK;
	FREETMPS;
	LEAVE;

	if (SvTRUE(ERRSV))
		ereport(ERROR,
				(errcode(ERRCODE_SYNTAX_ERROR),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV)))));

	if (!fc_subref)
		ereport(ERROR,
				(errcode(ERRCODE_SYNTAX_ERROR),
				 errmsg("didn't get a CODE reference from compiling function \"%s\"",
						fc_prodesc->proname)));

	fc_prodesc->reference = fc_subref;
}


/**********************************************************************
 * plperl_init_shared_libs()		-
 **********************************************************************/

static void fc_plperl_init_shared_libs(pTHX)
{
	char	   *fc_file = __FILE__;

	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, fc_file);
	newXS("PostgreSQL::InServer::Util::bootstrap",
		  boot_PostgreSQL__InServer__Util, fc_file);
	/* newXS for...::SPI::bootstrap 在 select_perl_context() 中 */
}


static SV  * fc_plperl_call_perl_func(plperl_proc_desc *fc_desc, FunctionCallInfo fc_fcinfo)
{
	dTHX;
	dSP;
	SV		   *fc_retval;
	int			fc_i;
	int			fc_count;
	Oid		   *fc_argtypes = NULL;
	int			fc_nargs = 0;

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	EXTEND(sp, fc_desc->nargs);

	/* 获取真实函数的签名；内联块没有参数。 */
	if (fc_fcinfo->flinfo->fn_oid)
		get_func_signature(fc_fcinfo->flinfo->fn_oid, &fc_argtypes, &fc_nargs);
	Assert(fc_nargs == fc_desc->nargs);

	for (fc_i = 0; fc_i < fc_desc->nargs; fc_i++)
	{
		if (fc_fcinfo->args[fc_i].isnull)
			PUSHs(&PL_sv_undef);
		else if (fc_desc->arg_is_rowtype[fc_i])
		{
			SV		   *fc_sv = fc_plperl_hash_from_datum(fc_fcinfo->args[fc_i].value);

			PUSHs(sv_2mortal(fc_sv));
		}
		else
		{
			SV		   *fc_sv;
			Oid			fc_funcid;

			if (OidIsValid(fc_desc->arg_arraytype[fc_i]))
				fc_sv = fc_plperl_ref_from_pg_array(fc_fcinfo->args[fc_i].value, fc_desc->arg_arraytype[fc_i]);
			else if ((fc_funcid = get_transform_fromsql(fc_argtypes[fc_i], current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
				fc_sv = (SV *) DatumGetPointer(OidFunctionCall1(fc_funcid, fc_fcinfo->args[fc_i].value));
			else
			{
				char	   *fc_tmp;

				fc_tmp = OutputFunctionCall(&(fc_desc->arg_out_func[fc_i]),
										 fc_fcinfo->args[fc_i].value);
				fc_sv = cstr2sv(fc_tmp);
				pfree(fc_tmp);
			}

			PUSHs(sv_2mortal(fc_sv));
		}
	}
	PUTBACK;

	/* 这里不要使用 G_KEEPERR */
	fc_count = call_sv(fc_desc->reference, G_SCALAR | G_EVAL);

	SPAGAIN;

	if (fc_count != 1)
	{
		PUTBACK;
		FREETMPS;
		LEAVE;
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("didn't get a return item from function")));
	}

	if (SvTRUE(ERRSV))
	{
		(void) POPs;
		PUTBACK;
		FREETMPS;
		LEAVE;
		/* XXX 需要找到一种更好的方式来确定此处的错误代码 */
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV)))));
	}

	fc_retval = newSVsv(POPs);

	PUTBACK;
	FREETMPS;
	LEAVE;

	return fc_retval;
}


static SV  * fc_plperl_call_perl_trigger_func(plperl_proc_desc *fc_desc, FunctionCallInfo fc_fcinfo,
							  SV *fc_td)
{
	dTHX;
	dSP;
	SV		   *fc_retval,
			   *fc_TDsv;
	int			fc_i,
				fc_count;
	Trigger    *fc_tg_trigger = ((TriggerData *) fc_fcinfo->context)->tg_trigger;

	ENTER;
	SAVETMPS;

	fc_TDsv = get_sv("main::_TD", 0);
	if (!fc_TDsv)
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("couldn't fetch $_TD")));

	save_item(fc_TDsv);			/* local $_TD */
	sv_setsv(fc_TDsv, fc_td);

	PUSHMARK(sp);
	EXTEND(sp, fc_tg_trigger->tgnargs);

	for (fc_i = 0; fc_i < fc_tg_trigger->tgnargs; fc_i++)
		PUSHs(sv_2mortal(cstr2sv(fc_tg_trigger->tgargs[fc_i])));
	PUTBACK;

	/* 这里不要使用 G_KEEPERR */
	fc_count = call_sv(fc_desc->reference, G_SCALAR | G_EVAL);

	SPAGAIN;

	if (fc_count != 1)
	{
		PUTBACK;
		FREETMPS;
		LEAVE;
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("didn't get a return item from trigger function")));
	}

	if (SvTRUE(ERRSV))
	{
		(void) POPs;
		PUTBACK;
		FREETMPS;
		LEAVE;
		/* XXX 需要找到一种更好的方式来确定此处的错误代码 */
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV)))));
	}

	fc_retval = newSVsv(POPs);

	PUTBACK;
	FREETMPS;
	LEAVE;

	return fc_retval;
}


static void fc_plperl_call_perl_event_trigger_func(plperl_proc_desc *fc_desc,
									FunctionCallInfo fc_fcinfo,
									SV *fc_td)
{
	dTHX;
	dSP;
	SV		   *fc_retval,
			   *fc_TDsv;
	int			fc_count;

	ENTER;
	SAVETMPS;

	fc_TDsv = get_sv("main::_TD", 0);
	if (!fc_TDsv)
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("couldn't fetch $_TD")));

	save_item(fc_TDsv);			/* local $_TD */
	sv_setsv(fc_TDsv, fc_td);

	PUSHMARK(sp);
	PUTBACK;

	/* 这里不要使用 G_KEEPERR */
	fc_count = call_sv(fc_desc->reference, G_SCALAR | G_EVAL);

	SPAGAIN;

	if (fc_count != 1)
	{
		PUTBACK;
		FREETMPS;
		LEAVE;
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("didn't get a return item from trigger function")));
	}

	if (SvTRUE(ERRSV))
	{
		(void) POPs;
		PUTBACK;
		FREETMPS;
		LEAVE;
		/* XXX 需要找到一种更好的方式来确定此处的错误代码 */
		ereport(ERROR,
				(errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION),
				 errmsg("%s", fc_strip_trailing_ws(sv2cstr(ERRSV)))));
	}

	fc_retval = newSVsv(POPs);
	(void) fc_retval;				/* 消除编译器警告 */

	PUTBACK;
	FREETMPS;
	LEAVE;
}

static Datum fc_plperl_func_handler(PG_FUNCTION_ARGS)
{
	bool		fc_nonatomic;
	plperl_proc_desc *fc_prodesc;
	SV		   *fc_perlret;
	Datum		fc_retval = 0;
	ReturnSetInfo *fc_rsi;
	ErrorContextCallback fc_pl_error_context;

	fc_nonatomic = fcinfo->context &&
		IsA(fcinfo->context, CallContext) &&
		!castNode(CallContext, fcinfo->context)->atomic;

	if (SPI_connect_ext(fc_nonatomic ? SPI_OPT_NONATOMIC : 0) != SPI_OK_CONNECT)
		elog(ERROR, "could not connect to SPI manager");

	fc_prodesc = fc_compile_plperl_function(fcinfo->flinfo->fn_oid, false, false);
	current_call_data->prodesc = fc_prodesc;
	increment_prodesc_refcount(fc_prodesc);

	/* 设置错误报告的回调函数 */
	fc_pl_error_context.callback = fc_plperl_exec_callback;
	fc_pl_error_context.previous = error_context_stack;
	fc_pl_error_context.arg = fc_prodesc->proname;
	error_context_stack = &fc_pl_error_context;

	fc_rsi = (ReturnSetInfo *) fcinfo->resultinfo;

	if (fc_prodesc->fn_retisset)
	{
		/* 在允许调用之前检查上下文 */
		if (!fc_rsi || !IsA(fc_rsi, ReturnSetInfo))
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("set-valued function called in context that cannot accept a set")));

		if (!(fc_rsi->allowedModes & SFRM_Materialize))
			ereport(ERROR,
					(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
					 errmsg("materialize mode required, but it is not allowed in this context")));
	}

	fc_activate_interpreter(fc_prodesc->interp);

	fc_perlret = fc_plperl_call_perl_func(fc_prodesc, fcinfo);

	/************************************************************
	 * 与 SPI 管理器断开连接，然后创建返回
	 * 值数据项（如果输入函数为其做了 palloc
	 * 则不能在 SPI 内存上下文中分配它，
	 * 因为 SPI_finish 会释放它）。
	 ************************************************************/
	if (SPI_finish() != SPI_OK_FINISH)
		elog(ERROR, "SPI_finish() failed");

	if (fc_prodesc->fn_retisset)
	{
		SV		   *fc_sav;

		/*
		 * 如果 Perl 函数返回了一个数组引用，我们假装它
		 * 对数组的每个元素调用了 return_next()，以处理不
		 * 知道 return_next() 的旧 SRF。任何其他类型的返回
		 * 值都是错误，除了 undef 意味着返回一个空集。
		 */
		fc_sav = fc_get_perl_array_ref(fc_perlret);
		if (fc_sav)
		{
			dTHX;
			int			fc_i = 0;
			SV		  **fc_svp = 0;
			AV		   *fc_rav = (AV *) SvRV(fc_sav);

			while ((fc_svp = av_fetch(fc_rav, fc_i, FALSE)) != NULL)
			{
				fc_plperl_return_next_internal(*fc_svp);
				fc_i++;
			}
		}
		else if (SvOK(fc_perlret))
		{
			ereport(ERROR,
					(errcode(ERRCODE_DATATYPE_MISMATCH),
					 errmsg("set-returning PL/Perl function must return "
							"reference to array or use return_next")));
		}

		fc_rsi->returnMode = SFRM_Materialize;
		if (current_call_data->tuple_store)
		{
			fc_rsi->setResult = current_call_data->tuple_store;
			fc_rsi->setDesc = current_call_data->ret_tdesc;
		}
		fc_retval = (Datum) 0;
	}
	else if (fc_prodesc->result_oid)
	{
		fc_retval = fc_plperl_sv_to_datum(fc_perlret,
									fc_prodesc->result_oid,
									-1,
									fcinfo,
									&fc_prodesc->result_in_func,
									fc_prodesc->result_typioparam,
									&fcinfo->isnull);

		if (fcinfo->isnull && fc_rsi && IsA(fc_rsi, ReturnSetInfo))
			fc_rsi->isDone = ExprEndResult;
	}

	/* 恢复先前的错误回调 */
	error_context_stack = fc_pl_error_context.previous;

	fc_SvREFCNT_dec_current(fc_perlret);

	return fc_retval;
}


static Datum fc_plperl_trigger_handler(PG_FUNCTION_ARGS)
{
	plperl_proc_desc *fc_prodesc;
	SV		   *fc_perlret;
	Datum		fc_retval;
	SV		   *fc_svTD;
	HV		   *fc_hvTD;
	ErrorContextCallback fc_pl_error_context;
	TriggerData *fc_tdata;
	int			fc_rc PG_USED_FOR_ASSERTS_ONLY;

	/* 连接到 SPI 管理器 */
	if (SPI_connect() != SPI_OK_CONNECT)
		elog(ERROR, "could not connect to SPI manager");

	/* 使过渡表对该 SPI 连接可见 */
	fc_tdata = (TriggerData *) fcinfo->context;
	fc_rc = SPI_register_trigger_data(fc_tdata);
	Assert(fc_rc >= 0);

	/* 查找或编译函数 */
	fc_prodesc = fc_compile_plperl_function(fcinfo->flinfo->fn_oid, true, false);
	current_call_data->prodesc = fc_prodesc;
	increment_prodesc_refcount(fc_prodesc);

	/* 设置错误报告的回调函数 */
	fc_pl_error_context.callback = fc_plperl_exec_callback;
	fc_pl_error_context.previous = error_context_stack;
	fc_pl_error_context.arg = fc_prodesc->proname;
	error_context_stack = &fc_pl_error_context;

	fc_activate_interpreter(fc_prodesc->interp);

	fc_svTD = fc_plperl_trigger_build_args(fcinfo);
	fc_perlret = fc_plperl_call_perl_trigger_func(fc_prodesc, fcinfo, fc_svTD);
	fc_hvTD = (HV *) SvRV(fc_svTD);

	/************************************************************
	* 与 SPI 管理器断开连接，然后创建返回
	* 值数据项（如果输入函数为其做了 palloc
	* 则不能在 SPI 内存上下文中分配它，
	* 因为 SPI_finish 会释放它）。
	************************************************************/
	if (SPI_finish() != SPI_OK_FINISH)
		elog(ERROR, "SPI_finish() failed");

	if (fc_perlret == NULL || !SvOK(fc_perlret))
	{
		/* undef 结果意味着继续使用原始元组 */
		TriggerData *fc_trigdata = ((TriggerData *) fcinfo->context);

		if (TRIGGER_FIRED_BY_INSERT(fc_trigdata->tg_event))
			fc_retval = (Datum) fc_trigdata->tg_trigtuple;
		else if (TRIGGER_FIRED_BY_UPDATE(fc_trigdata->tg_event))
			fc_retval = (Datum) fc_trigdata->tg_newtuple;
		else if (TRIGGER_FIRED_BY_DELETE(fc_trigdata->tg_event))
			fc_retval = (Datum) fc_trigdata->tg_trigtuple;
		else if (TRIGGER_FIRED_BY_TRUNCATE(fc_trigdata->tg_event))
			fc_retval = (Datum) fc_trigdata->tg_trigtuple;
		else
			fc_retval = (Datum) 0; /* 这可能发生吗？ */
	}
	else
	{
		HeapTuple	fc_trv;
		char	   *fc_tmp;

		fc_tmp = sv2cstr(fc_perlret);

		if (pg_strcasecmp(fc_tmp, "SKIP") == 0)
			fc_trv = NULL;
		else if (pg_strcasecmp(fc_tmp, "MODIFY") == 0)
		{
			TriggerData *fc_trigdata = (TriggerData *) fcinfo->context;

			if (TRIGGER_FIRED_BY_INSERT(fc_trigdata->tg_event))
				fc_trv = fc_plperl_modify_tuple(fc_hvTD, fc_trigdata,
											fc_trigdata->tg_trigtuple);
			else if (TRIGGER_FIRED_BY_UPDATE(fc_trigdata->tg_event))
				fc_trv = fc_plperl_modify_tuple(fc_hvTD, fc_trigdata,
											fc_trigdata->tg_newtuple);
			else
			{
				ereport(WARNING,
						(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
						 errmsg("ignoring modified row in DELETE trigger")));
				fc_trv = NULL;
			}
		}
		else
		{
			ereport(ERROR,
					(errcode(ERRCODE_E_R_I_E_TRIGGER_PROTOCOL_VIOLATED),
					 errmsg("result of PL/Perl trigger function must be undef, "
							"\"SKIP\", or \"MODIFY\"")));
			fc_trv = NULL;
		}
		fc_retval = PointerGetDatum(fc_trv);
		pfree(fc_tmp);
	}

	/* 恢复先前的错误回调 */
	error_context_stack = fc_pl_error_context.previous;

	fc_SvREFCNT_dec_current(fc_svTD);
	if (fc_perlret)
		fc_SvREFCNT_dec_current(fc_perlret);

	return fc_retval;
}


static void fc_plperl_event_trigger_handler(PG_FUNCTION_ARGS)
{
	plperl_proc_desc *fc_prodesc;
	SV		   *fc_svTD;
	ErrorContextCallback fc_pl_error_context;

	/* 连接到 SPI 管理器 */
	if (SPI_connect() != SPI_OK_CONNECT)
		elog(ERROR, "could not connect to SPI manager");

	/* 查找或编译函数 */
	fc_prodesc = fc_compile_plperl_function(fcinfo->flinfo->fn_oid, false, true);
	current_call_data->prodesc = fc_prodesc;
	increment_prodesc_refcount(fc_prodesc);

	/* 设置错误报告的回调函数 */
	fc_pl_error_context.callback = fc_plperl_exec_callback;
	fc_pl_error_context.previous = error_context_stack;
	fc_pl_error_context.arg = fc_prodesc->proname;
	error_context_stack = &fc_pl_error_context;

	fc_activate_interpreter(fc_prodesc->interp);

	fc_svTD = fc_plperl_event_trigger_build_args(fcinfo);
	fc_plperl_call_perl_event_trigger_func(fc_prodesc, fcinfo, fc_svTD);

	if (SPI_finish() != SPI_OK_FINISH)
		elog(ERROR, "SPI_finish() failed");

	/* 恢复先前的错误回调 */
	error_context_stack = fc_pl_error_context.previous;

	fc_SvREFCNT_dec_current(fc_svTD);
}


static bool fc_validate_plperl_function(plperl_proc_ptr *fc_proc_ptr, HeapTuple fc_procTup)
{
	if (fc_proc_ptr && fc_proc_ptr->proc_ptr)
	{
		plperl_proc_desc *fc_prodesc = fc_proc_ptr->proc_ptr;
		bool		fc_uptodate;

		/************************************************************
		 * 如果存在，必须检查它是否仍然是最新的。
		 * 这是必要的，因为 CREATE OR REPLACE FUNCTION 可以修改
		 * 函数的 pg_proc 条目而不更改其 OID。
		 ************************************************************/
		fc_uptodate = (fc_prodesc->fn_xmin == HeapTupleHeaderGetRawXmin(fc_procTup->t_data) &&
					ItemPointerEquals(&fc_prodesc->fn_tid, &fc_procTup->t_self));

		if (fc_uptodate)
			return true;

		/* 否则，从哈希表中删除过时的条目... */
		fc_proc_ptr->proc_ptr = NULL;
		/* ...并释放相应的引用计数，可能会删除它 */
		decrement_prodesc_refcount(fc_prodesc);
	}

	return false;
}


static void fc_free_plperl_function(plperl_proc_desc *fc_prodesc)
{
	Assert(fc_prodesc->fn_refcount == 0);
	/* 从适当的解释器释放 CODE 引用（如果有） */
	if (fc_prodesc->reference)
	{
		plperl_interp_desc *fc_oldinterp = plperl_active_interp;

		fc_activate_interpreter(fc_prodesc->interp);
		fc_SvREFCNT_dec_current(fc_prodesc->reference);
		fc_activate_interpreter(fc_oldinterp);
	}
	/* 释放该过程的所有 PG 拥有的数据 */
	MemoryContextDelete(fc_prodesc->fn_cxt);
}


static plperl_proc_desc *
fc_compile_plperl_function(Oid fc_fn_oid, bool fc_is_trigger, bool fc_is_event_trigger)
{
	HeapTuple	fc_procTup;
	Form_pg_proc fc_procStruct;
	plperl_proc_key fc_proc_key;
	plperl_proc_ptr *fc_proc_ptr;
	plperl_proc_desc *volatile fc_prodesc = NULL;
	volatile MemoryContext fc_proc_cxt = NULL;
	plperl_interp_desc *fc_oldinterp = plperl_active_interp;
	ErrorContextCallback fc_plperl_error_context;

	/* 无论如何我们都需要 pg_proc 元组... */
	fc_procTup = SearchSysCache1(PROCOID, ObjectIdGetDatum(fc_fn_oid));
	if (!HeapTupleIsValid(fc_procTup))
		elog(ERROR, "cache lookup failed for function %u", fc_fn_oid);
	fc_procStruct = (Form_pg_proc) GETSTRUCT(fc_procTup);

	/*
	 * 尝试在 plperl_proc_hash 中查找函数。这个看起来复杂的查找过程的原因是我们不知道它是 plperl 还是 plperlu，并且不想花时间在 pg_language 中查找以确认。
	 */
	fc_proc_key.proc_id = fc_fn_oid;
	fc_proc_key.is_trigger = fc_is_trigger;
	fc_proc_key.user_id = GetUserId();
	fc_proc_ptr = hash_search(plperl_proc_hash, &fc_proc_key,
						   HASH_FIND, NULL);
	if (fc_validate_plperl_function(fc_proc_ptr, fc_procTup))
	{
		/* 找到有效的 plperl 条目 */
		ReleaseSysCache(fc_procTup);
		return fc_proc_ptr->proc_ptr;
	}

	/* 如果未找到或过时，可能是 plperlu */
	fc_proc_key.user_id = InvalidOid;
	fc_proc_ptr = hash_search(plperl_proc_hash, &fc_proc_key,
						   HASH_FIND, NULL);
	if (fc_validate_plperl_function(fc_proc_ptr, fc_procTup))
	{
		/* 找到有效的 plperlu 条目 */
		ReleaseSysCache(fc_procTup);
		return fc_proc_ptr->proc_ptr;
	}

	/************************************************************
	 * 如果我们在哈希表中没有找到它，我们将分析
	 * 函数的参数和返回类型，并将
	 * 输入/输出函数存储在 prodesc 块中，
	 * 然后我们将过程加载到 Perl 解释器中，
	 * 最后我们为它创建一个新的哈希表条目。
	 ************************************************************/

	/* 设置一个回调以报告编译错误 */
	fc_plperl_error_context.callback = fc_plperl_compile_callback;
	fc_plperl_error_context.previous = error_context_stack;
	fc_plperl_error_context.arg = NameStr(fc_procStruct->proname);
	error_context_stack = &fc_plperl_error_context;

	PG_TRY();
	{
		HeapTuple	fc_langTup;
		HeapTuple	fc_typeTup;
		Form_pg_language fc_langStruct;
		Form_pg_type fc_typeStruct;
		Datum		fc_protrftypes_datum;
		Datum		fc_prosrcdatum;
		bool		fc_isnull;
		char	   *fc_proc_source;
		MemoryContext fc_oldcontext;

		/************************************************************
		 * 分配一个上下文，以保存过程的所有 PG 数据。
		 ************************************************************/
		fc_proc_cxt = AllocSetContextCreate(TopMemoryContext,
										 "PL/Perl function",
										 ALLOCSET_SMALL_SIZES);

		/************************************************************
		 * 分配并填充一个新的过程描述块。
		 * struct prodesc 及其附属数据必须都存储在 proc_cxt 中。
		 ************************************************************/
		fc_oldcontext = MemoryContextSwitchTo(fc_proc_cxt);
		fc_prodesc = (plperl_proc_desc *) palloc0(sizeof(plperl_proc_desc));
		fc_prodesc->proname = pstrdup(NameStr(fc_procStruct->proname));
		MemoryContextSetIdentifier(fc_proc_cxt, fc_prodesc->proname);
		fc_prodesc->fn_cxt = fc_proc_cxt;
		fc_prodesc->fn_refcount = 0;
		fc_prodesc->fn_xmin = HeapTupleHeaderGetRawXmin(fc_procTup->t_data);
		fc_prodesc->fn_tid = fc_procTup->t_self;
		fc_prodesc->nargs = fc_procStruct->pronargs;
		fc_prodesc->arg_out_func = (FmgrInfo *) palloc0(fc_prodesc->nargs * sizeof(FmgrInfo));
		fc_prodesc->arg_is_rowtype = (bool *) palloc0(fc_prodesc->nargs * sizeof(bool));
		fc_prodesc->arg_arraytype = (Oid *) palloc0(fc_prodesc->nargs * sizeof(Oid));
		MemoryContextSwitchTo(fc_oldcontext);

		/* 记住函数是否为 STABLE/IMMUTABLE */
		fc_prodesc->fn_readonly =
			(fc_procStruct->provolatile != PROVOLATILE_VOLATILE);

		/* 获取 protrftypes */
		fc_protrftypes_datum = SysCacheGetAttr(PROCOID, fc_procTup,
											Anum_pg_proc_protrftypes, &fc_isnull);
		MemoryContextSwitchTo(fc_proc_cxt);
		fc_prodesc->trftypes = fc_isnull ? NIL : oid_array_to_list(fc_protrftypes_datum);
		MemoryContextSwitchTo(fc_oldcontext);

		/************************************************************
		 * 通过 Oid 查找 pg_language 元组
		 ************************************************************/
		fc_langTup = SearchSysCache1(LANGOID,
								  ObjectIdGetDatum(fc_procStruct->prolang));
		if (!HeapTupleIsValid(fc_langTup))
			elog(ERROR, "cache lookup failed for language %u",
				 fc_procStruct->prolang);
		fc_langStruct = (Form_pg_language) GETSTRUCT(fc_langTup);
		fc_prodesc->lang_oid = fc_langStruct->oid;
		fc_prodesc->lanpltrusted = fc_langStruct->lanpltrusted;
		ReleaseSysCache(fc_langTup);

		/************************************************************
		 * 获取返回值输入转换所需的信息。
		 ************************************************************/
		if (!fc_is_trigger && !fc_is_event_trigger)
		{
			Oid			fc_rettype = fc_procStruct->prorettype;

			fc_typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(fc_rettype));
			if (!HeapTupleIsValid(fc_typeTup))
				elog(ERROR, "cache lookup failed for type %u", fc_rettype);
			fc_typeStruct = (Form_pg_type) GETSTRUCT(fc_typeTup);

			/* 不允许伪类型返回，除了 VOID 或 RECORD */
			if (fc_typeStruct->typtype == TYPTYPE_PSEUDO)
			{
				if (fc_rettype == VOIDOID ||
					fc_rettype == RECORDOID)
					 /* 可以 */ ;
				else if (fc_rettype == TRIGGEROID ||
						 fc_rettype == EVENT_TRIGGEROID)
					ereport(ERROR,
							(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
							 errmsg("trigger functions can only be called "
									"as triggers")));
				else
					ereport(ERROR,
							(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
							 errmsg("PL/Perl functions cannot return type %s",
									format_type_be(fc_rettype))));
			}

			fc_prodesc->result_oid = fc_rettype;
			fc_prodesc->fn_retisset = fc_procStruct->proretset;
			fc_prodesc->fn_retistuple = type_is_rowtype(fc_rettype);
			fc_prodesc->fn_retisarray = IsTrueArrayType(fc_typeStruct);

			fmgr_info_cxt(fc_typeStruct->typinput,
						  &(fc_prodesc->result_in_func),
						  fc_proc_cxt);
			fc_prodesc->result_typioparam = getTypeIOParam(fc_typeTup);

			ReleaseSysCache(fc_typeTup);
		}

		/************************************************************
		 * 获取所有过程参数的输出转换所需的信息
		 ************************************************************/
		if (!fc_is_trigger && !fc_is_event_trigger)
		{
			int			fc_i;

			for (fc_i = 0; fc_i < fc_prodesc->nargs; fc_i++)
			{
				Oid			fc_argtype = fc_procStruct->proargtypes.values[fc_i];

				fc_typeTup = SearchSysCache1(TYPEOID, ObjectIdGetDatum(fc_argtype));
				if (!HeapTupleIsValid(fc_typeTup))
					elog(ERROR, "cache lookup failed for type %u", fc_argtype);
				fc_typeStruct = (Form_pg_type) GETSTRUCT(fc_typeTup);

				/* 不允许伪类型参数，除了 RECORD */
				if (fc_typeStruct->typtype == TYPTYPE_PSEUDO &&
					fc_argtype != RECORDOID)
					ereport(ERROR,
							(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
							 errmsg("PL/Perl functions cannot accept type %s",
									format_type_be(fc_argtype))));

				if (type_is_rowtype(fc_argtype))
					fc_prodesc->arg_is_rowtype[fc_i] = true;
				else
				{
					fc_prodesc->arg_is_rowtype[fc_i] = false;
					fmgr_info_cxt(fc_typeStruct->typoutput,
								  &(fc_prodesc->arg_out_func[fc_i]),
								  fc_proc_cxt);
				}

				/* 确定数组类型参数 */
				if (IsTrueArrayType(fc_typeStruct))
					fc_prodesc->arg_arraytype[fc_i] = fc_argtype;
				else
					fc_prodesc->arg_arraytype[fc_i] = InvalidOid;

				ReleaseSysCache(fc_typeTup);
			}
		}

		/************************************************************
		 * 创建匿名子例程的文本。
		 * 我们不使用命名子例程，以便可以直接通过引用调用。
		 ************************************************************/
		fc_prosrcdatum = SysCacheGetAttr(PROCOID, fc_procTup,
									  Anum_pg_proc_prosrc, &fc_isnull);
		if (fc_isnull)
			elog(ERROR, "null prosrc");
		fc_proc_source = TextDatumGetCString(fc_prosrcdatum);

		/************************************************************
		 * 在适当的解释器中创建过程
		 ************************************************************/

		fc_select_perl_context(fc_prodesc->lanpltrusted);

		fc_prodesc->interp = plperl_active_interp;

		fc_plperl_create_sub(fc_prodesc, fc_proc_source, fc_fn_oid);

		fc_activate_interpreter(fc_oldinterp);

		pfree(fc_proc_source);

		if (!fc_prodesc->reference)	/* 这可能发生吗？ */
			elog(ERROR, "could not create PL/Perl internal procedure");

		/************************************************************
		 * 好吧，将过程链接到正确的哈希表条目中。
		 * 注意，我们假设哈希表条目要么尚不存在，
		 * 要么我们已经在上面的验证尝试中清除了它的 proc_ptr。
		 * 所以这里不需要减少旧的引用计数。
************************************************************/
		fc_proc_key.user_id = fc_prodesc->lanpltrusted ? GetUserId() : InvalidOid;

		fc_proc_ptr = hash_search(plperl_proc_hash, &fc_proc_key,
							   HASH_ENTER, NULL);
		/* 我们假设这两个步骤不会抛出错误： */
		fc_proc_ptr->proc_ptr = fc_prodesc;
		increment_prodesc_refcount(fc_prodesc);
	}
	PG_CATCH();
	{
		/*
		 * 如果我们走到创建引用的这一步，我们应该能够使用
		 * free_plperl_function() 来清理。如果不行，那么最多我们有
		 * 一些在 proc_cxt 中的 PG 内存资源，我们可以直接删除。
		 */
		if (fc_prodesc && fc_prodesc->reference)
			fc_free_plperl_function(fc_prodesc);
		else if (fc_proc_cxt)
			MemoryContextDelete(fc_proc_cxt);

		/* 记得也要恢复之前的解释器，以图好运 */
		fc_activate_interpreter(fc_oldinterp);

		PG_RE_THROW();
	}
	PG_END_TRY();

	/* 恢复以前的错误回调 */
	error_context_stack = fc_plperl_error_context.previous;

	ReleaseSysCache(fc_procTup);

	return fc_prodesc;
}

/* 从给定的复合/行数据构建哈希 */
static SV  * fc_plperl_hash_from_datum(Datum fc_attr)
{
	HeapTupleHeader fc_td;
	Oid			fc_tupType;
	int32		fc_tupTypmod;
	TupleDesc	fc_tupdesc;
	HeapTupleData fc_tmptup;
	SV		   *fc_sv;

	fc_td = DatumGetHeapTupleHeader(fc_attr);

	/* 提取行类型信息并找到 tupdesc */
	fc_tupType = HeapTupleHeaderGetTypeId(fc_td);
	fc_tupTypmod = HeapTupleHeaderGetTypMod(fc_td);
	fc_tupdesc = lookup_rowtype_tupdesc(fc_tupType, fc_tupTypmod);

	/* 构建一个临时 HeapTuple 控制结构 */
	fc_tmptup.t_len = HeapTupleHeaderGetDatumLength(fc_td);
	fc_tmptup.t_data = fc_td;

	fc_sv = fc_plperl_hash_from_tuple(&fc_tmptup, fc_tupdesc, true);
	ReleaseTupleDesc(fc_tupdesc);

	return fc_sv;
}

/* 从给定元组的所有属性构建哈希。 */
static SV  * fc_plperl_hash_from_tuple(HeapTuple fc_tuple, TupleDesc fc_tupdesc, bool fc_include_generated)
{
	dTHX;
	HV		   *fc_hv;
	int			fc_i;

	/* 由于这个函数递归，可能会导致栈溢出 */
	check_stack_depth();

	fc_hv = newHV();
	hv_ksplit(fc_hv, fc_tupdesc->natts);	/* 预先扩展哈希 */

	for (fc_i = 0; fc_i < fc_tupdesc->natts; fc_i++)
	{
		Datum		fc_attr;
		bool		fc_isnull,
					fc_typisvarlena;
		char	   *fc_attname;
		Oid			fc_typoutput;
		Form_pg_attribute fc_att = TupleDescAttr(fc_tupdesc, fc_i);

		if (fc_att->attisdropped)
			continue;

		if (fc_att->attgenerated)
		{
			/* 除非请求，否则不包含 */
			if (!fc_include_generated)
				continue;
		}

		fc_attname = NameStr(fc_att->attname);
		fc_attr = heap_getattr(fc_tuple, fc_i + 1, fc_tupdesc, &fc_isnull);

		if (fc_isnull)
		{
			/*
			 * 存储 (attname => undef) 并继续。注意，我们不能在这里使用
			 * &PL_sv_undef；请参见 perlguts 中的“A
			 * Vs，HVs 和未定义的值”以获得解释。
			 */
			fc_hv_store_string(fc_hv, fc_attname, newSV(0));
			continue;
		}

		if (type_is_rowtype(fc_att->atttypid))
		{
			SV		   *fc_sv = fc_plperl_hash_from_datum(fc_attr);

			fc_hv_store_string(fc_hv, fc_attname, fc_sv);
		}
		else
		{
			SV		   *fc_sv;
			Oid			fc_funcid;

			if (OidIsValid(get_base_element_type(fc_att->atttypid)))
				fc_sv = fc_plperl_ref_from_pg_array(fc_attr, fc_att->atttypid);
			else if ((fc_funcid = get_transform_fromsql(fc_att->atttypid, current_call_data->prodesc->lang_oid, current_call_data->prodesc->trftypes)))
				fc_sv = (SV *) DatumGetPointer(OidFunctionCall1(fc_funcid, fc_attr));
			else
			{
				char	   *fc_outputstr;

				/* XXX 应该有一种方法来缓存这些查找 */
				getTypeOutputInfo(fc_att->atttypid, &fc_typoutput, &fc_typisvarlena);

				fc_outputstr = OidOutputFunctionCall(fc_typoutput, fc_attr);
				fc_sv = cstr2sv(fc_outputstr);
				pfree(fc_outputstr);
			}

			fc_hv_store_string(fc_hv, fc_attname, fc_sv);
		}
	}
	return newRV_noinc((SV *) fc_hv);
}


static void fc_check_spi_usage_allowed(void)
{
	/* 请参见 plperl_fini() 中的注释 */
	if (plperl_ending)
	{
		/* 简单的抛出错误，因为我们不想牵涉 PostgreSQL 代码 */
		croak("SPI functions can not be used in END blocks");
	}

	/*
	 * 如果我们没有执行完全编译的 plperl
	 * 函数，则不允许使用 SPI。 在这种情况下，似乎不可能到达这里，但实际上有
	 * Perl 会在编译期间尝试执行代码的情况。如果
	 * 我们继续，可能会因为试图解引用 prodesc
	 * 指针而崩溃。 绕过这个问题可能是可能的，但似乎不明智，
	 * 因为它会在验证函数时允许代码执行，这是不必要的。
	 */
	if (current_call_data == NULL || current_call_data->prodesc == NULL)
	{
		/* 简单的抛出错误，因为我们不想牵涉 PostgreSQL 代码 */
		croak("SPI functions can not be used during function compilation");
	}
}


HV *
plperl_spi_exec(char *fc_query, int fc_limit)
{
	HV		   *fc_ret_hv;

	/*
	 * 在子事务中执行查询，以便我们可以理智地处理错误
	 */
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	/* 希望在函数的内存上下文中运行 */
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		int			fc_spi_rv;

		pg_verifymbstr(fc_query, strlen(fc_query), false);

		fc_spi_rv = SPI_execute(fc_query, current_call_data->prodesc->fn_readonly,
							 fc_limit);
		fc_ret_hv = fc_plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
												fc_spi_rv);

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	return fc_ret_hv;
}


static HV  *
fc_plperl_spi_execute_fetch_result(SPITupleTable *fc_tuptable, uint64 fc_processed,
								int fc_status)
{
	dTHX;
	HV		   *fc_result;

	fc_check_spi_usage_allowed();

	fc_result = newHV();

	fc_hv_store_string(fc_result, "status",
					cstr2sv(SPI_result_code_string(fc_status)));
	fc_hv_store_string(fc_result, "processed",
					(fc_processed > (uint64) UV_MAX) ?
					newSVnv((NV) fc_processed) :
					newSVuv((UV) fc_processed));

	if (fc_status > 0 && fc_tuptable)
	{
		AV		   *fc_rows;
		SV		   *fc_row;
		uint64		fc_i;

		/* 防止 av_extend() 调用中的溢出 */
		if (fc_processed > (uint64) AV_SIZE_MAX)
			ereport(ERROR,
					(errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
					 errmsg("query result has too many rows to fit in a Perl array")));

		fc_rows = newAV();
		av_extend(fc_rows, fc_processed);
		for (fc_i = 0; fc_i < fc_processed; fc_i++)
		{
			fc_row = fc_plperl_hash_from_tuple(fc_tuptable->vals[fc_i], fc_tuptable->tupdesc, true);
			av_push(fc_rows, fc_row);
		}
		fc_hv_store_string(fc_result, "rows",
						newRV_noinc((SV *) fc_rows));
	}

	SPI_freetuptable(fc_tuptable);

	return fc_result;
}


/*
 * plperl_return_next 捕获任何错误并将其转换为 Perl 错误。
 * 我们假设（也许没有充分的理由）如果 Perl 代码捕获了错误，
 * 则不需要中止当前事务。
 */
void plperl_return_next(SV *fc_sv)
{
	MemoryContext fc_oldcontext = CurrentMemoryContext;

	fc_check_spi_usage_allowed();

	PG_TRY();
	{
		fc_plperl_return_next_internal(fc_sv);
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 必须重置 elog.c 的状态 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);
	}
	PG_END_TRY();
}

/*
 * plperl_return_next_internal 以 PostgreSQL 的方式报告任何错误
 * （通过 ereport）。
 */
static void fc_plperl_return_next_internal(SV *fc_sv)
{
	plperl_proc_desc *fc_prodesc;
	FunctionCallInfo fc_fcinfo;
	ReturnSetInfo *fc_rsi;
	MemoryContext fc_old_cxt;

	if (!fc_sv)
		return;

	fc_prodesc = current_call_data->prodesc;
	fc_fcinfo = current_call_data->fcinfo;
	fc_rsi = (ReturnSetInfo *) fc_fcinfo->resultinfo;

	if (!fc_prodesc->fn_retisset)
		ereport(ERROR,
				(errcode(ERRCODE_SYNTAX_ERROR),
				 errmsg("cannot use return_next in a non-SETOF function")));

	if (!current_call_data->ret_tdesc)
	{
		TupleDesc	fc_tupdesc;

		Assert(!current_call_data->tuple_store);

		/*
		 * 这是当前 PL/Perl 函数调用中第一次调用 return_next，因此识别输出元组类型并创建一个元组存储以保存结果行。
		 */
		if (fc_prodesc->fn_retistuple)
		{
			TypeFuncClass fc_funcclass;
			Oid			fc_typid;

			fc_funcclass = get_call_result_type(fc_fcinfo, &fc_typid, &fc_tupdesc);
			if (fc_funcclass != TYPEFUNC_COMPOSITE &&
				fc_funcclass != TYPEFUNC_COMPOSITE_DOMAIN)
				ereport(ERROR,
						(errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
						 errmsg("function returning record called in context "
								"that cannot accept type record")));
			/* 如果是域-复合类型，记住域的类型 OID */
			if (fc_funcclass == TYPEFUNC_COMPOSITE_DOMAIN)
				current_call_data->cdomain_oid = fc_typid;
		}
		else
		{
			fc_tupdesc = fc_rsi->expectedDesc;
			/* 保护下面的假设，即我们返回恰好一个列 */
			if (fc_tupdesc == NULL || fc_tupdesc->natts != 1)
				elog(ERROR, "expected single-column result descriptor for non-composite SETOF result");
		}

		/*
		 * 确保元组存储和 ret_tdesc 的生存期足够长。
		 */
		fc_old_cxt = MemoryContextSwitchTo(fc_rsi->econtext->ecxt_per_query_memory);

		current_call_data->ret_tdesc = CreateTupleDescCopy(fc_tupdesc);
		current_call_data->tuple_store =
			tuplestore_begin_heap(fc_rsi->allowedModes & SFRM_Materialize_Random,
								  false, work_mem);

		MemoryContextSwitchTo(fc_old_cxt);
	}

	/*
	 * 生成我们想返回的元组需要进行大量 palloc() 分配，而这些分配不会被清理。由于该函数可以在当前内存上下文重置之前被多次调用，我们需要在临时上下文中进行这些分配。
	 */
	if (!current_call_data->tmp_cxt)
	{
		current_call_data->tmp_cxt =
			AllocSetContextCreate(CurrentMemoryContext,
								  "PL/Perl return_next temporary cxt",
								  ALLOCSET_DEFAULT_SIZES);
	}

	fc_old_cxt = MemoryContextSwitchTo(current_call_data->tmp_cxt);

	if (fc_prodesc->fn_retistuple)
	{
		HeapTuple	fc_tuple;

		if (!(SvOK(fc_sv) && SvROK(fc_sv) && SvTYPE(SvRV(fc_sv)) == SVt_PVHV))
			ereport(ERROR,
					(errcode(ERRCODE_DATATYPE_MISMATCH),
					 errmsg("SETOF-composite-returning PL/Perl function "
							"must call return_next with reference to hash")));

		fc_tuple = fc_plperl_build_tuple_result((HV *) SvRV(fc_sv),
										  current_call_data->ret_tdesc);

		if (OidIsValid(current_call_data->cdomain_oid))
			domain_check(HeapTupleGetDatum(fc_tuple), false,
						 current_call_data->cdomain_oid,
						 &current_call_data->cdomain_info,
						 fc_rsi->econtext->ecxt_per_query_memory);

		tuplestore_puttuple(current_call_data->tuple_store, fc_tuple);
	}
	else if (fc_prodesc->result_oid)
	{
		Datum		fc_ret[1];
		bool		fc_isNull[1];

		fc_ret[0] = fc_plperl_sv_to_datum(fc_sv,
									fc_prodesc->result_oid,
									-1,
									fc_fcinfo,
									&fc_prodesc->result_in_func,
									fc_prodesc->result_typioparam,
									&fc_isNull[0]);

		tuplestore_putvalues(current_call_data->tuple_store,
							 current_call_data->ret_tdesc,
							 fc_ret, fc_isNull);
	}

	MemoryContextSwitchTo(fc_old_cxt);
	MemoryContextReset(current_call_data->tmp_cxt);
}


SV * plperl_spi_query(char *fc_query)
{
	SV		   *fc_cursor;

	/*
	 * 在子事务中执行查询，以便我们可以理智地处理错误
	 */
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	/* 希望在函数的内存上下文中运行 */
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		SPIPlanPtr	fc_plan;
		Portal		fc_portal;

		/* 确保查询是有效编码 */
		pg_verifymbstr(fc_query, strlen(fc_query), false);

		/* 为查询创建游标 */
		fc_plan = SPI_prepare(fc_query, 0, NULL);
		if (fc_plan == NULL)
			elog(ERROR, "SPI_prepare() failed:%s",
				 SPI_result_code_string(SPI_result));

		fc_portal = SPI_cursor_open(NULL, fc_plan, NULL, NULL, false);
		SPI_freeplan(fc_plan);
		if (fc_portal == NULL)
			elog(ERROR, "SPI_cursor_open() failed:%s",
				 SPI_result_code_string(SPI_result));
		fc_cursor = cstr2sv(fc_portal->name);

		PinPortal(fc_portal);

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	return fc_cursor;
}


SV * plperl_spi_fetchrow(char *fc_cursor)
{
	SV		   *fc_row;

	/*
	 * 在子事务中执行 FETCH，以便我们能够理智地处理错误
	 */
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	/* 希望在函数的内存上下文中运行 */
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		dTHX;
		Portal		fc_p = SPI_cursor_find(fc_cursor);

		if (!fc_p)
		{
			fc_row = &PL_sv_undef;
		}
		else
		{
			SPI_cursor_fetch(fc_p, true, 1);
			if (SPI_processed == 0)
			{
				UnpinPortal(fc_p);
				SPI_cursor_close(fc_p);
				fc_row = &PL_sv_undef;
			}
			else
			{
				fc_row = fc_plperl_hash_from_tuple(SPI_tuptable->vals[0],
											 SPI_tuptable->tupdesc,
											 true);
			}
			SPI_freetuptable(SPI_tuptable);
		}

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	return fc_row;
}

void plperl_spi_cursor_close(char *fc_cursor)
{
	Portal		fc_p;

	fc_check_spi_usage_allowed();

	fc_p = SPI_cursor_find(fc_cursor);

	if (fc_p)
	{
		UnpinPortal(fc_p);
		SPI_cursor_close(fc_p);
	}
}

SV * plperl_spi_prepare(char *fc_query, int fc_argc, SV **fc_argv)
{
	volatile SPIPlanPtr fc_plan = NULL;
	volatile MemoryContext fc_plan_cxt = NULL;
	plperl_query_desc *volatile fc_qdesc = NULL;
	plperl_query_entry *volatile fc_hash_entry = NULL;
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;
	MemoryContext fc_work_cxt;
	bool		fc_found;
	int			fc_i;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		CHECK_FOR_INTERRUPTS();

		/************************************************************
		 * 分配新的 querydesc 结构
		 *
		 * qdesc 结构以及所有其子数据存在于其 plan_cxt 中。但请注意，SPIPlan 并不在其中。
		 ************************************************************/
		fc_plan_cxt = AllocSetContextCreate(TopMemoryContext,
										 "PL/Perl spi_prepare query",
										 ALLOCSET_SMALL_SIZES);
		MemoryContextSwitchTo(fc_plan_cxt);
		fc_qdesc = (plperl_query_desc *) palloc0(sizeof(plperl_query_desc));
		snprintf(fc_qdesc->qname, sizeof(fc_qdesc->qname), "%p", fc_qdesc);
		fc_qdesc->plan_cxt = fc_plan_cxt;
		fc_qdesc->nargs = fc_argc;
		fc_qdesc->argtypes = (Oid *) palloc(fc_argc * sizeof(Oid));
		fc_qdesc->arginfuncs = (FmgrInfo *) palloc(fc_argc * sizeof(FmgrInfo));
		fc_qdesc->argtypioparams = (Oid *) palloc(fc_argc * sizeof(Oid));
		MemoryContextSwitchTo(fc_oldcontext);

		/************************************************************
		 * 在短期上下文中执行以下工作，以便我们不会在 PL/Perl 函数的 SPI Proc 上下文中泄漏大量内存。
		 ************************************************************/
		fc_work_cxt = AllocSetContextCreate(CurrentMemoryContext,
										 "PL/Perl spi_prepare workspace",
										 ALLOCSET_DEFAULT_SIZES);
		MemoryContextSwitchTo(fc_work_cxt);

		/************************************************************
		 * 解析参数类型名称，然后根据 oid 在系统缓存中查找，并记住输入转换所需的信息。
		 ************************************************************/
		for (fc_i = 0; fc_i < fc_argc; fc_i++)
		{
			Oid			fc_typId,
						fc_typInput,
						fc_typIOParam;
			int32		fc_typmod;
			char	   *fc_typstr;

			fc_typstr = sv2cstr(fc_argv[fc_i]);
			parseTypeString(fc_typstr, &fc_typId, &fc_typmod, false);
			pfree(fc_typstr);

			getTypeInputInfo(fc_typId, &fc_typInput, &fc_typIOParam);

			fc_qdesc->argtypes[fc_i] = fc_typId;
			fmgr_info_cxt(fc_typInput, &(fc_qdesc->arginfuncs[fc_i]), fc_plan_cxt);
			fc_qdesc->argtypioparams[fc_i] = fc_typIOParam;
		}

		/* 确保查询是有效编码 */
		pg_verifymbstr(fc_query, strlen(fc_query), false);

		/************************************************************
		 * 准备计划并检查错误
		 ************************************************************/
		fc_plan = SPI_prepare(fc_query, fc_argc, fc_qdesc->argtypes);

		if (fc_plan == NULL)
			elog(ERROR, "SPI_prepare() failed:%s",
				 SPI_result_code_string(SPI_result));

		/************************************************************
		 * 将计划保存到永久内存中（现在它位于 SPI procCxt 中，该上下文将在函数结束时消失）。
		 ************************************************************/
		if (SPI_keepplan(fc_plan))
			elog(ERROR, "SPI_keepplan() failed");
		fc_qdesc->plan = fc_plan;

		/************************************************************
		 * 为计划插入一个哈希表条目。
		 ************************************************************/
		fc_hash_entry = hash_search(plperl_active_interp->query_hash,
								 fc_qdesc->qname,
								 HASH_ENTER, &fc_found);
		fc_hash_entry->query_data = fc_qdesc;

		/* 清理工作空间 */
		MemoryContextDelete(fc_work_cxt);

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 释放我们成功分配的任何资源 */
		if (fc_hash_entry)
			hash_search(plperl_active_interp->query_hash,
						fc_qdesc->qname,
						HASH_REMOVE, NULL);
		if (fc_plan_cxt)
			MemoryContextDelete(fc_plan_cxt);
		if (fc_plan)
			SPI_freeplan(fc_plan);

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	/************************************************************
	 * 将查询的哈希键返回给调用者。
	 ************************************************************/
	return cstr2sv(fc_qdesc->qname);
}

HV *
plperl_spi_exec_prepared(char *fc_query, HV *fc_attr, int fc_argc, SV **fc_argv)
{
	HV		   *fc_ret_hv;
	SV		  **fc_sv;
	int			fc_i,
				fc_limit,
				fc_spi_rv;
	char	   *fc_nulls;
	Datum	   *fc_argvalues;
	plperl_query_desc *fc_qdesc;
	plperl_query_entry *fc_hash_entry;

	/*
	 * 在子事务中执行查询，以便我们可以理智地处理错误
	 */
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	/* 希望在函数的内存上下文中运行 */
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		dTHX;

		/************************************************************
		 * 获取保存的计划描述符，检查是否正常。
		 ************************************************************/
		fc_hash_entry = hash_search(plperl_active_interp->query_hash, fc_query,
								 HASH_FIND, NULL);
		if (fc_hash_entry == NULL)
			elog(ERROR, "spi_exec_prepared: Invalid prepared query passed");

		fc_qdesc = fc_hash_entry->query_data;
		if (fc_qdesc == NULL)
			elog(ERROR, "spi_exec_prepared: plperl query_hash value vanished");

		if (fc_qdesc->nargs != fc_argc)
			elog(ERROR, "spi_exec_prepared: expected %d argument(s), %d passed",
				 fc_qdesc->nargs, fc_argc);

		/************************************************************
		 * 解析最终属性
		 ************************************************************/
		fc_limit = 0;
		if (fc_attr != NULL)
		{
			fc_sv = fc_hv_fetch_string(fc_attr, "limit");
			if (fc_sv && *fc_sv && SvIOK(*fc_sv))
				fc_limit = SvIV(*fc_sv);
		}
		/************************************************************
		 * 设置参数
		 ************************************************************/
		if (fc_argc > 0)
		{
			fc_nulls = (char *) palloc(fc_argc);
			fc_argvalues = (Datum *) palloc(fc_argc * sizeof(Datum));
		}
		else
		{
			fc_nulls = NULL;
			fc_argvalues = NULL;
		}

		for (fc_i = 0; fc_i < fc_argc; fc_i++)
		{
			bool		fc_isnull;

			fc_argvalues[fc_i] = fc_plperl_sv_to_datum(fc_argv[fc_i],
											  fc_qdesc->argtypes[fc_i],
											  -1,
											  NULL,
											  &fc_qdesc->arginfuncs[fc_i],
											  fc_qdesc->argtypioparams[fc_i],
											  &fc_isnull);
			fc_nulls[fc_i] = fc_isnull ? 'n' : ' ';
		}

		/************************************************************
		 * 开始
		 ************************************************************/
		fc_spi_rv = SPI_execute_plan(fc_qdesc->plan, fc_argvalues, fc_nulls,
								  current_call_data->prodesc->fn_readonly, fc_limit);
		fc_ret_hv = fc_plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed,
												 fc_spi_rv);
		if (fc_argc > 0)
		{
			pfree(fc_argvalues);
			pfree(fc_nulls);
		}

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	return fc_ret_hv;
}

SV * plperl_spi_query_prepared(char *fc_query, int fc_argc, SV **fc_argv)
{
	int			fc_i;
	char	   *fc_nulls;
	Datum	   *fc_argvalues;
	plperl_query_desc *fc_qdesc;
	plperl_query_entry *fc_hash_entry;
	SV		   *fc_cursor;
	Portal		fc_portal = NULL;

	/*
	 * 在子事务中执行查询，以便我们可以理智地处理错误
	 */
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	ResourceOwner fc_oldowner = CurrentResourceOwner;

	fc_check_spi_usage_allowed();

	BeginInternalSubTransaction(NULL);
	/* 希望在函数的内存上下文中运行 */
	MemoryContextSwitchTo(fc_oldcontext);

	PG_TRY();
	{
		/************************************************************
		 * 获取保存的计划描述符，检查是否正常。
		 ************************************************************/
		fc_hash_entry = hash_search(plperl_active_interp->query_hash, fc_query,
								 HASH_FIND, NULL);
		if (fc_hash_entry == NULL)
			elog(ERROR, "spi_query_prepared: Invalid prepared query passed");

		fc_qdesc = fc_hash_entry->query_data;
		if (fc_qdesc == NULL)
			elog(ERROR, "spi_query_prepared: plperl query_hash value vanished");

		if (fc_qdesc->nargs != fc_argc)
			elog(ERROR, "spi_query_prepared: expected %d argument(s), %d passed",
				 fc_qdesc->nargs, fc_argc);

		/************************************************************
		 * 设置参数
		 ************************************************************/
		if (fc_argc > 0)
		{
			fc_nulls = (char *) palloc(fc_argc);
			fc_argvalues = (Datum *) palloc(fc_argc * sizeof(Datum));
		}
		else
		{
			fc_nulls = NULL;
			fc_argvalues = NULL;
		}

		for (fc_i = 0; fc_i < fc_argc; fc_i++)
		{
			bool		fc_isnull;

			fc_argvalues[fc_i] = fc_plperl_sv_to_datum(fc_argv[fc_i],
											  fc_qdesc->argtypes[fc_i],
											  -1,
											  NULL,
											  &fc_qdesc->arginfuncs[fc_i],
											  fc_qdesc->argtypioparams[fc_i],
											  &fc_isnull);
			fc_nulls[fc_i] = fc_isnull ? 'n' : ' ';
		}

		/************************************************************
		 * 开始
		 ************************************************************/
		fc_portal = SPI_cursor_open(NULL, fc_qdesc->plan, fc_argvalues, fc_nulls,
								 current_call_data->prodesc->fn_readonly);
		if (fc_argc > 0)
		{
			pfree(fc_argvalues);
			pfree(fc_nulls);
		}
		if (fc_portal == NULL)
			elog(ERROR, "SPI_cursor_open() failed:%s",
				 SPI_result_code_string(SPI_result));

		fc_cursor = cstr2sv(fc_portal->name);

		PinPortal(fc_portal);

		/* 提交内部事务，返回外部事务上下文 */
		ReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 中止内部事务 */
		RollbackAndReleaseCurrentSubTransaction();
		MemoryContextSwitchTo(fc_oldcontext);
		CurrentResourceOwner = fc_oldowner;

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);

		/* 不能到这里，但保持编译器安静 */
		return NULL;
	}
	PG_END_TRY();

	return fc_cursor;
}

void plperl_spi_freeplan(char *fc_query)
{
	SPIPlanPtr	fc_plan;
	plperl_query_desc *fc_qdesc;
	plperl_query_entry *fc_hash_entry;

	fc_check_spi_usage_allowed();

	fc_hash_entry = hash_search(plperl_active_interp->query_hash, fc_query,
							 HASH_FIND, NULL);
	if (fc_hash_entry == NULL)
		elog(ERROR, "spi_freeplan: Invalid prepared query passed");

	fc_qdesc = fc_hash_entry->query_data;
	if (fc_qdesc == NULL)
		elog(ERROR, "spi_freeplan: plperl query_hash value vanished");
	fc_plan = fc_qdesc->plan;

	/*
	 * 在调用SPI_freeplan之前释放所有内存，这样如果出现问题，就不会留下任何东西
	 */
	hash_search(plperl_active_interp->query_hash, fc_query,
				HASH_REMOVE, NULL);

	MemoryContextDelete(fc_qdesc->plan_cxt);

	SPI_freeplan(fc_plan);
}

void plperl_spi_commit(void)
{
	MemoryContext fc_oldcontext = CurrentMemoryContext;

	fc_check_spi_usage_allowed();

	PG_TRY();
	{
		SPI_commit();
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);
	}
	PG_END_TRY();
}

void plperl_spi_rollback(void)
{
	MemoryContext fc_oldcontext = CurrentMemoryContext;

	fc_check_spi_usage_allowed();

	PG_TRY();
	{
		SPI_rollback();
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 保存错误信息 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);
	}
	PG_END_TRY();
}

/*
 * plperl的elog()函数的实现
 *
 * 如果错误级别低于ERROR，我们将仅发出消息并返回。当它是ERROR时，elog()会longjmp，我们捕获这个并将其转变为Perl的croak()。请注意，我们假设elog()不会有任何内部故障严重到需要中止事务。
 *
 * 这个函数被单独实现的主要原因是为了避免XSUB.h和PG_TRY宏之间的冲突。
 */
void plperl_util_elog(int fc_level, SV *fc_msg)
{
	MemoryContext fc_oldcontext = CurrentMemoryContext;
	char	   *volatile fc_cmsg = NULL;

	/*
	 * 我们故意省略check_spi_usage_allowed()，因为即使在该函数拒绝的上下文中也似乎安全。
	 */

	PG_TRY();
	{
		fc_cmsg = sv2cstr(fc_msg);
		elog(fc_level, "%s", fc_cmsg);
		pfree(fc_cmsg);
	}
	PG_CATCH();
	{
		ErrorData  *fc_edata;

		/* 必须重置 elog.c 的状态 */
		MemoryContextSwitchTo(fc_oldcontext);
		fc_edata = CopyErrorData();
		FlushErrorState();

		if (fc_cmsg)
			pfree(fc_cmsg);

		/* 将错误交给 Perl */
		croak_cstr(fc_edata->message);
	}
	PG_END_TRY();
}

/*
 * 将一个SV存储到一个哈希表中，键是一个假设为当前数据库编码的字符串。
 */
static SV **
fc_hv_store_string(HV *fc_hv, const char *fc_key, SV *fc_val)
{
	dTHX;
	int32		fc_hlen;
	char	   *fc_hkey;
	SV		  **fc_ret;

	fc_hkey = pg_server_to_any(fc_key, strlen(fc_key), PG_UTF8);

	/*
	 * hv_store()将负的klen参数识别为意味着一个UTF-8编码的键。
	 */
	fc_hlen = -(int) strlen(fc_hkey);
	fc_ret = hv_store(fc_hv, fc_hkey, fc_hlen, fc_val, 0);

	if (fc_hkey != fc_key)
		pfree(fc_hkey);

	return fc_ret;
}

/*
 * 从哈希表中获取一个SV，键是一个假设为当前数据库编码的字符串。
 */
static SV **
fc_hv_fetch_string(HV *fc_hv, const char *fc_key)
{
	dTHX;
	int32		fc_hlen;
	char	   *fc_hkey;
	SV		  **fc_ret;

	fc_hkey = pg_server_to_any(fc_key, strlen(fc_key), PG_UTF8);

	/* See notes in fc_hv_store_string */
	fc_hlen = -(int) strlen(fc_hkey);
	fc_ret = hv_fetch(fc_hv, fc_hkey, fc_hlen, 0);

	if (fc_hkey != fc_key)
		pfree(fc_hkey);

	return fc_ret;
}

/*
 * 提供PL/Perl执行错误的函数名称
 */
static void fc_plperl_exec_callback(void *fc_arg)
{
	char	   *fc_procname = (char *) fc_arg;

	if (fc_procname)
		errcontext("PL/Perl function \"%s\"", fc_procname);
}

/*
 * 提供PL/Perl编译错误的函数名称
 */
static void fc_plperl_compile_callback(void *fc_arg)
{
	char	   *fc_procname = (char *) fc_arg;

	if (fc_procname)
		errcontext("compilation of PL/Perl function \"%s\"", fc_procname);
}

/*
 * 为内联处理程序提供错误上下文
 */
static void fc_plperl_inline_callback(void *fc_arg)
{
	errcontext("PL/Perl anonymous code block");
}


/*
 * Perl自己的setlocale()，复制自POSIX.xs
 * （需要因为调用new_*()）
 *
 * 从5.28开始，perl暴露Perl_setlocale以实现此功能。
 */
#if defined(WIN32) && PERL_VERSION_LT(5, 28, 0)
static char * setlocale_perl(int category, char *locale)
{
	dTHX;
	char	   *RETVAL = setlocale(category, locale);

	if (RETVAL)
	{
#ifdef USE_LOCALE_CTYPE
		if (category == LC_CTYPE
#ifdef LC_ALL
			|| category == LC_ALL
#endif
			)
		{
			char	   *newctype;

#ifdef LC_ALL
			if (category == LC_ALL)
				newctype = setlocale(LC_CTYPE, NULL);
			else
#endif
				newctype = RETVAL;
			new_ctype(newctype);
		}
#endif							/* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
		if (category == LC_COLLATE
#ifdef LC_ALL
			|| category == LC_ALL
#endif
			)
		{
			char	   *newcoll;

#ifdef LC_ALL
			if (category == LC_ALL)
				newcoll = setlocale(LC_COLLATE, NULL);
			else
#endif
				newcoll = RETVAL;
			new_collate(newcoll);
		}
#endif							/* USE_LOCALE_COLLATE */

#ifdef USE_LOCALE_NUMERIC
		if (category == LC_NUMERIC
#ifdef LC_ALL
			|| category == LC_ALL
#endif
			)
		{
			char	   *newnum;

#ifdef LC_ALL
			if (category == LC_ALL)
				newnum = setlocale(LC_NUMERIC, NULL);
			else
#endif
				newnum = RETVAL;
			new_numeric(newnum);
		}
#endif							/* USE_LOCALE_NUMERIC */
	}

	return RETVAL;
}
#endif							/* 定义(WIN32) && PERL_VERSION_LT(5, 28, 0) */
